Skip to content

Commit

Permalink
optimize
Browse files Browse the repository at this point in the history
  • Loading branch information
@hsk
hsk committed Feb 11, 2015
1 parent 3900033 commit db1d362
Show file tree
Hide file tree
Showing 5 changed files with 62 additions and 41 deletions.
2 changes: 1 addition & 1 deletion src/parser.mly
View file
Original file line number Diff line number Diff line change
Expand Up @@ -136,7 +136,7 @@ exp:
| simple_exp DOT LPAREN exp RPAREN LESS_MINUS exp { Put($1, $4, $7) }
| simple_exp DOT IDENT LESS_MINUS exp { Put($1, Str $3, $5) }
| simple_exp COLON_EQUAL exp { Put($1, Str "ref", $3) }
| exp SEMICOLON exp { Let(Syntax.gentmp (), $1, $3) }
| exp SEMICOLON exp { Let("", $1, $3) }
| ARRAY_CREATE simple_exp simple_exp %prec prec_app { Array($2, $3) }
| error
{ failwith
Expand Down
4 changes: 2 additions & 2 deletions src2/parser.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,7 @@ let ident i = i |> (
((skip >> (range 'a' 'z' <|> nstr "_") <~> rep(range 'A' 'Z' <|>range 'a' 'z' <|> range '0' '9' <|> nstr "_") ) >>>(fun (a,b)->String.concat "" (a::b)))
>>> (fun (a,b)->a^b))
>?> (function
| "_" -> genid ""
| "_" -> ""
| a when not(List.mem a keywords) -> a
| _ -> failwith "error"
)
Expand Down Expand Up @@ -84,7 +84,7 @@ and fields i = i |> (
and exp i = i |> (
(_let <~> rep(str ";" >> _let) >>> (fun (a, bs) ->
List.fold_left (fun a b ->
Let(genid "", a, b)
Let("", a, b)
) a bs
))
)
Expand Down
9 changes: 9 additions & 0 deletions src3/emit.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,7 @@ let rec o_j fp = function
| JGet(e1,e2) -> Format.fprintf fp "%a[%a]" o_j e1 o_j e2
| JPut(e1,e2,e3) -> Format.fprintf fp "%a[%a]=%a" o_j e1 o_j e2 o_j e3
| JPre(op,e1) -> Format.fprintf fp "(%s %a)" op o_j e1
| JApp(e,[JUndefined]) -> Format.fprintf fp "%a()" o_j e
| JApp(e,es) -> Format.fprintf fp "%a(%a)" o_j e o_js es
| JIf(e1,e2,e3) -> Format.fprintf fp "(%a ? %a : %a)" o_j e1 o_j e2 o_j e3
| JFun(is, s) -> Format.fprintf fp "(function(%a){%a})" o_is is o_s s
Expand All @@ -43,10 +44,18 @@ and o_ijs fp js =
Format.fprintf fp "%a@?" (os o_ij) js

and o_s fp = function
| SVar(i,JVar j) when i = j -> ()
| SVar("",JVar j) -> ()
| SVar("",j) -> Format.fprintf fp "%a;" o_j j
| SVar(i,j) -> Format.fprintf fp "var %s = %a;" i o_j j
| SDef("") -> ()
| SDef(i) -> Format.fprintf fp "var %s;" i
| SAssign(i,JVar j) when i = j -> ()
| SAssign("",JVar j) -> ()
| SAssign("",j) -> Format.fprintf fp "%a;" o_j j
| SAssign(i,j) -> Format.fprintf fp "%s = %a;" i o_j j
| SExp(j) -> Format.fprintf fp "%a;" o_j j
| SRet(JUndefined) -> Format.fprintf fp "return;"
| SRet(j) -> Format.fprintf fp "return %a;" o_j j
| SIf(j,s1, s2) -> Format.fprintf fp "if(%a) %a else %a" o_j j o_s2 s1 o_s2 s2
| SFun(i,is, s) -> Format.fprintf fp "function %s(%a) {%a}" i o_is is o_s s
Expand Down
2 changes: 1 addition & 1 deletion src3/inline.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,7 @@ let inline env (zs,e) (ys:e list) =
let (zs,e) = List.fold_right2 (fun z y (zs, e) ->
match y with
| Var n -> ((z,n)::zs, e)
| _ -> let i = genid "z" in ((z,i)::zs, Let(i, y, e))
| _ -> let i = gentmp() in ((z,i)::zs, Let(i, y, e))
) zs ys ([],e) in

Alpha.g zs e
Expand Down
86 changes: 49 additions & 37 deletions src3/javascript.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -79,7 +79,12 @@ let (@@) a b =
if a = SNil then b else
if b = SNil then a else SCons(a,b)

let rec cnve = function
type r =
| RRet
| RExp
| RVar of string

let rec cnve tl = function
| Int(i) -> SNil,JInt(i)
| Float(i) -> SNil,JFloat(i)
| Var(i) -> SNil,JVar(i)
Expand All @@ -88,73 +93,80 @@ let rec cnve = function
| Bool(i) -> SNil,JBool(i)
| Unit -> SNil,JUndefined
| Bin(e1,op,e2) ->
let s1,j1 = cnve e1 in
let s2,j2 = cnve e2 in
let s1,j1 = cnve tl e1 in
let s2,j2 = cnve tl e2 in
s1 @@ s2, JBin(j1, op, j2)
| Get(e1,e2) ->
let s1,j1 = cnve e1 in
let s2,j2 = cnve e2 in
let s1,j1 = cnve tl e1 in
let s2,j2 = cnve tl e2 in
s1 @@ s2, JGet(j1, j2)
| Put(e1,e2,e3) ->
let s1,j1 = cnve e1 in
let s2,j2 = cnve e2 in
let s3,j3 = cnve e3 in
let s1,j1 = cnve tl e1 in
let s2,j2 = cnve tl e2 in
let s3,j3 = cnve tl e3 in
s1 @@ s2 @@ s3, JPut(j1, j2, j3)
| Pre(op,e1) ->
let s1,j1 = cnve e1 in
let s1,j1 = cnve tl e1 in
s1, JPre(op, j1)
| App(e,es) ->
let s,j = cnve e in
let s,j = cnve tl e in
let ss,js = List.fold_right (fun e (ls,es) ->
let l,e = cnve e in
let l,e = cnve tl e in
l @@ ls, (e::es)
) es (SNil,[]) in
s @@ ss, JApp(j, js)
| If(e1,e2,e3) ->
let s1,j1 = cnve e1 in
let s2,j2 = cnve e2 in
let s3,j3 = cnve e3 in
let i = genid "tmp" in
SDef(i) @@ s1 @@ SIf(j1, s2 @@ SAssign(i,j2), s3 @@ SAssign(i,j3)), JVar(i)
| Let(i,e1,e2) ->
let s1, j1 = cnve e1 in
let s2, j2 = cnve e2 in
let s1, j1 = cnve tl e1 in
let s2, j2 = cnve tl e2 in
s1 @@ SVar(i, j1) @@ s2, j2
| LetRec(i, Fun(is, e1), e2) ->
let s1 = cnv true e1 in
let s2, j2 = cnve e2 in
let s1 = cnv RRet e1 in
let s2, j2 = cnve tl e2 in
SFun(i, is, s1) @@ s2, j2

| Fun(is, e1) ->
let s1 = cnv true e1 in
let s1 = cnv RRet e1 in
SNil, JFun(is, s1)
| Rec(ies) ->

let ss,js = List.fold_right (fun (i,e) (ls,es) ->
let l,e = cnve e in
let l,e = cnve tl e in
l @@ ls, ((i,e)::es)
) ies (SNil,[]) in
ss,JRec(js)

| If(e1,e2,e3) ->
begin match tl with
| RVar i ->
let s1,j1 = cnve RExp e1 in
let s2,j2 = cnve tl e2 in
let s3,j3 = cnve tl e3 in
s1 @@ SIf(j1, s2 @@ SAssign(i,j2), s3 @@ SAssign(i,j3)), JVar(i)
| _ ->
let s1,j1 = cnve RExp e1 in
let s2,j2 = cnve tl e2 in
let s3,j3 = cnve tl e3 in
let i = gentmp () in
SDef(i) @@ s1 @@ SIf(j1, s2 @@ SAssign(i,j2), s3 @@ SAssign(i,j3)), JVar(i)
end
| e -> Format.fprintf Format.std_formatter "error %a@." show_e e; assert false

and cnv tl = function
| Let(i,e1,e2) ->
let s1, j1 = cnve e1 in
s1 @@ SVar(i, j1) @@ cnv tl e2
let s1, j1 = cnve (RVar i) e1 in
begin match s1 with
| SNil -> SVar(i, j1) @@ cnv tl e2
| _ -> SDef(i) @@ s1 @@ SAssign(i, j1) @@ cnv tl e2
end
| LetRec(i, Fun(is, e1), e2) ->
let s1 = cnv true e1 in
let s1 = cnv RRet e1 in
SFun(i, is, s1) @@ cnv tl e2
| If(e1, e2, e3) when tl ->
let s1, j1 = cnve e1 in
let s2 = cnv true e2 in
let s3 = cnv true e3 in
| If(e1, e2, e3) when tl=RRet ->
let s1, j1 = cnve RExp e1 in
let s2 = cnv RRet e2 in
let s3 = cnv RRet e3 in
s1 @@ SIf(j1, s2, s3)
| e when tl ->
let s, j = cnve e in
s @@ SRet j
| e ->
let s, j = cnve e in
s @@ SExp j
let s, j = cnve RExp e in
s @@ (match tl with RRet -> SRet j | _ -> SExp j)

let f e = cnv false e
let f e = cnv RExp e

0 comments on commit db1d362

Please sign in to comment.