Skip to content
Browse files

Merge branch 'master' of hydra:/home/amishtal/repo-git/tiger

  • Loading branch information...
2 parents 5067f4d + db813bd commit 68b779375e70c298fc07cf3123f8e6d40a073343 @bsummer4 committed May 3, 2011
Showing with 229 additions and 100 deletions.
  1. +10 −0 TODO
  2. +93 −2 src/ir.sml
  3. +126 −98 src/toc.sml
View
10 TODO
@@ -20,3 +20,13 @@
:TODO: Write a makefile rule to run the each-file-on-a-line tests
cat ex/small_valid | (i=0; while read x; do echo "%% $x"; echo $x | ./o.parse; done) | less
+
+:TODO: Some style stuff
+ - IR.#ref' vs CIR.#isRef
+ - Functional record update
+ - Fold in {src/ll.sml}
+
+:TODO: Lexer bug
+ `4*5' works, but `4 * 5' doesn't
+
+:TODO: IR -> CIR
View
95 src/ir.sml
@@ -44,8 +44,8 @@ structure IR = struct
withtype texp = {e:exp, ty:Type.ty}
(*
- The `block' field in `vars' refers to where the block where a
- variable is defined or the block defined by a function depending
+ The `block' field in `vars' refers to where the block where a
+ variable is defined or the block defined by a function depending
on what type of variable it is. Note that `args' and `vars'
are disjoint sets and that the order of `args' is significant.
*)
@@ -68,3 +68,94 @@ structure IR = struct
, vars:vars
}
end
+
+
+structure IRSexp = struct
+ local
+ structure S = Sexp
+ open IR
+ structure T = Type
+ structure U = Util
+ val name = Symbol.unique
+ fun sym s = s
+ val fix = S.SYM o name
+ fun sexp s args = S.SEQ (S.SYM s::args)
+
+ fun opname oper = case oper
+ of ADD => "+" | SUB => "-" | MUL => "*" | DIV => "/" | EQ => "="
+ | NEQ => "<>" | LT => "<" | LE => "<=" | GT => ">" | GE => ">="
+ | AND => "&" | OR => "|"
+
+ fun expSexp e = case e
+ of ARR {size,init} => (case init
+ of SOME init => sexp "array" [texpSexp size, texpSexp init]
+ | NONE => S.SYM "array")
+ | ASSIGN {var=v,exp=e'} => sexp "assign" (varSexp v::[texpSexp e'])
+ | BREAK => sexp "break" []
+ | CALL {func:Symbol.symbol, args:texp list ref} => sexp "call" (fix func::map texpSexp (!args))
+ | IF {test,then'} => sexp "if" [texpSexp test, texpSexp then']
+ | IFELSE {test,then',else'} => sexp "ifelse" (map texpSexp [test,then',else'])
+ | INT i => sexp "int" [S.INT i]
+ | NIL => sexp "nil" []
+ | OP {left, oper, right} => sexp "op" (S.SYM(opname oper)::[texpSexp left, texpSexp right])
+ | REC l => (case l
+ of SOME l => sexp "rec"
+ (map (fn (s, te) => S.SEQ [fix s,texpSexp te])
+ (SymTable.listItemsi l))
+ | NONE => S.SYM "rec")
+ | SEQ l => sexp "seq" (map texpSexp l)
+ | STR s => sexp "str" [S.STR s]
+ | VAR v => varSexp v
+ | WHILE {test,body} => sexp "while" [texpSexp test,texpSexp body]
+
+ and varSexp v = case v
+ of SIMPLE s => sexp "simple-var" [fix s]
+ | FIELD (v,s) => sexp "field-var" [varSexp v,fix s]
+ | INDEX (v,te) => sexp "index-var" [varSexp v,texpSexp te]
+
+ and typSexp ty = case ty
+ of T.INT => sexp "type" [S.SYM "INT"]
+ | T.STR => sexp "type" [S.SYM "STR"]
+ | T.NIL => sexp "type" [S.SYM "NIL"]
+ | T.REC s => sexp "type" [S.SYM "record", fix s]
+ | T.ARR s => sexp "type" [S.SYM "array", fix s]
+
+ and texpSexp (te as {e,ty}) = sexp "texp" [typSexp ty, expSexp e]
+
+ and blockSexp (s,(b as {args,vars,subBlocks,up,body})) =
+ sexp "block" [ fix s
+ , sexp "args" (map fix args)
+ , sexp "vars" (map fix vars)
+ , sexp "subBlocks" (map fix subBlocks)
+ , sexp "up" (case up of SOME up' => [fix up'] | NONE => [] )
+ , sexp "body" [texpSexp body]
+ ]
+
+ and procSexp (s,(p as {res,args})) =
+ sexp (name s) [typSexp res, sexp "args" (map typSexp args)]
+
+ and arraySexp (s,a) = sexp (name s) [typSexp a]
+
+ and recordSexp (s,r) =
+ sexp (name s) (map (fn(s,typ)=>S.SEQ[fix s,typSexp typ])
+ (SymTable.listItemsi r))
+
+ and varSexp' (s, (v as {typ,block:Symbol.symbol,ref'})) =
+ sexp (name s) [typSexp typ, fix block, S.BOOL ref']
+
+
+ val x = {ty=T.INT,e=OP{oper=ADD,left={ty=T.INT, e=STR "3"}, right={ty=T.INT,e=INT 4}}}
+ val () = S.printSexp(texpSexp x);
+
+ in
+ fun programSexp (p:program as {main,blocks,procs,arrays,records,vars}) =
+ sexp "program" [fix main
+ , sexp "blocks" (map blockSexp (SymTable.listItemsi blocks))
+ , sexp "procs" (map procSexp (SymTable.listItemsi procs))
+ , sexp "array" (map arraySexp (SymTable.listItemsi arrays))
+ , sexp "records" (map recordSexp(SymTable.listItemsi records))
+ , sexp "vars" (map varSexp' (SymTable.listItemsi vars))
+ ]
+
+ end
+end
View
224 src/toc.sml
@@ -1,10 +1,10 @@
open IR
open Util
structure T=Type
+structure S=Symbol
val tmp = Symbol.mk "tmp"
-(* TODO this should insert the new variable into the current block *)
-fun tmpVar ty = SIMPLE(Symbol.gensym tmp)
+
fun unit e = {ty=T.UNIT,e=e}
fun seq el = unit(SEQ(el))
@@ -42,102 +42,130 @@ and expClass (texp as {ty,e}) = case e
| WHILE {test,body} =>
if okExp test andalso okStmt body then STMT else BAD
-fun fix (te as {e=exp,ty=typ}) = case exp
- of WHILE {test=test,body=body} =>
- if okExp test then unit(WHILE{test=test,body=(fix body)})
- else let val t = tmpVar T.INT
- val updateTest = fix(unit(ASSIGN{var=t,exp=test}))
- in seq[ updateTest
- , unit(WHILE{ test={ty=T.INT,e=VAR t}
- , body=seq[fix body, updateTest]
- })]
- end
-
- | SEQ l => {ty=typ,e=SEQ (map fix l)}
-
- | ASSIGN {var,exp as {ty,e}} =>
- (case e
- of (SEQ el) =>
- (case splitForLast el of (prefix,last) =>
- fix({ty=ty,e=SEQ(List.concat
- [prefix,
- [{ ty=ty
- , e=ASSIGN{var=var,exp=last}
- }]])}))
- | (IFELSE{test,then',else'}) =>
- fix(unit(IFELSE{ test=test
- , then'=unit(ASSIGN{var=var, exp=then'})
- , else'=unit(ASSIGN{var=var, exp=else'})
- }))
- | _ => if okExp exp then te else fix(unit((ASSIGN{var=var, exp=(fix exp)}))))
-
- | CALL {func, args=(ref args)} =>
- let val tmps = map (fn{ty,e}=>(ty,e,tmpVar ty)) args
- val args = map (fn(ty,_,v)=>{ty=ty,e=VAR v}) tmps
- val setup = map (fn(ty,e,v)=>unit(ASSIGN{var=v,exp={e=e,ty=ty}}))
- tmps
- in {ty=typ,e=SEQ
- [ seq setup
- , {ty=typ,e=CALL{func=func,args=ref args}}
- ]}
- end
-
- | IF {test, then'} =>
- fix(unit(IFELSE{test=test, then'=then', else'=(unit (SEQ []))}))
-
- | IFELSE {test, then', else'} =>
- let val t = tmpVar T.INT
- in {ty=typ, e=SEQ[ fix(unit(ASSIGN{var=t, exp=test}))
- , {ty=typ, e=IFELSE{ test={ty=T.INT, e=VAR t}
- , then'=fix(then')
- , else'=fix(else')}}]}
- end
-
- | OP {left, oper, right} =>
- (case left of {ty, e} =>
- let val t1 = tmpVar ty
- val t2 = tmpVar ty
- in {ty=typ, e=SEQ
- [ fix(unit(ASSIGN{var=t1, exp=left}))
- , fix(unit(ASSIGN{var=t2, exp=right}))
- , { ty=typ, e=OP{ left={ty=ty, e=VAR t1}
- , oper=oper
- , right={ty=ty, e=VAR t2}}}]}
- end)
-
- | ARR {size, init=SOME init} =>
- let val t1 = tmpVar T.INT
- val t2 = tmpVar typ
- val t3 = tmpVar T.INT
- in {ty=typ, e=SEQ
- [ fix(unit(ASSIGN{var=t1, exp=size}))
- , unit(ASSIGN{ var=t2
- , exp={ty=typ
- , e=ARR{ size={ty=T.INT, e=VAR t1}
- , init=NONE}}})
- , unit(WHILE{ test={ ty=T.INT
- , e=OP{ left={ty=T.INT,e=VAR t3}
- , oper=LT
- , right={ty=T.INT,e=VAR t1}}}
- , body=fix(unit(ASSIGN{ var=INDEX(t2, { ty=T.INT
- , e=VAR t3})
- , exp=init}))})
- , {ty=typ, e=VAR t2}]}
- end
-
- | REC (SOME l) =>
- let val t = tmpVar typ
- fun foo (sym,{ty,e}) =
- fix(unit(ASSIGN{var=(FIELD(t,sym)),exp={ty=ty,e=e}}))
- val inits = ST.listItems (ST.mapi foo l)
- in { ty=typ
- , e=SEQ(List.concat[ [unit(ASSIGN{var=t, exp={ty=typ, e=REC NONE}})]
- , inits
- , [{ty=typ, e=VAR t}]])
- }
- end
-
- | _ => te
+fun push vl e = vl:=(e::(!vl))
+
+(* fix :: (sym*ty) list ref -> (program * texp) -> (program * texp) *)
+fun fix vl p (te as {e=exp,ty=typ}) =
+ let val fix = fix vl p
+ fun tmpVar ty =
+ let val sym = Symbol.gensym tmp
+ val () = push vl (sym,ty)
+ in SIMPLE sym
+ end
+ in case exp
+
+ of WHILE {test=test,body=body} =>
+ if okExp test then unit(WHILE{test=test,body=(fix body)})
+ else let val t = tmpVar T.INT
+ val updateTest = fix(unit(ASSIGN{var=t,exp=test}))
+ in seq[ updateTest
+ , unit(WHILE{ test={ty=T.INT,e=VAR t}
+ , body=seq[fix body, updateTest]
+ })]
+ end
+
+ | SEQ l => {ty=typ,e=SEQ (map fix l)}
+
+ | ASSIGN {var,exp as {ty,e}} =>
+ (case e
+ of (SEQ el) =>
+ (case splitForLast el of (prefix,last) =>
+ fix({ty=ty,e=SEQ(List.concat
+ [prefix,
+ [{ ty=ty
+ , e=ASSIGN{var=var,exp=last}
+ }]])}))
+ | (IFELSE{test,then',else'}) =>
+ fix(unit(IFELSE{ test=test
+ , then'=unit(ASSIGN{var=var, exp=then'})
+ , else'=unit(ASSIGN{var=var, exp=else'})
+ }))
+ | _ => if okExp exp then te else fix(unit((ASSIGN{var=var, exp=(fix exp)}))))
+
+ | CALL {func, args=(ref args)} =>
+ let val tmps = map (fn{ty,e}=>(ty,e,tmpVar ty)) args
+ val args = map (fn(ty,_,v)=>{ty=ty,e=VAR v}) tmps
+ val setup = map (fn(ty,e,v)=>unit(ASSIGN{var=v,exp={e=e,ty=ty}}))
+ tmps
+ in {ty=typ,e=SEQ
+ [ seq setup
+ , {ty=typ,e=CALL{func=func,args=ref args}}
+ ]}
+ end
+
+ | IF {test, then'} =>
+ fix(unit(IFELSE{test=test, then'=then', else'=(unit (SEQ []))}))
+
+ | IFELSE {test, then', else'} =>
+ let val t = tmpVar T.INT
+ in {ty=typ, e=SEQ[ fix(unit(ASSIGN{var=t, exp=test}))
+ , {ty=typ, e=IFELSE{ test={ty=T.INT, e=VAR t}
+ , then'=fix(then')
+ , else'=fix(else')}}]}
+ end
+
+ | OP {left, oper, right} =>
+ (case left of {ty, e} =>
+ let val t1 = tmpVar ty
+ val t2 = tmpVar ty
+ in {ty=typ, e=SEQ
+ [ fix(unit(ASSIGN{var=t1, exp=left}))
+ , fix(unit(ASSIGN{var=t2, exp=right}))
+ , { ty=typ, e=OP{ left={ty=ty, e=VAR t1}
+ , oper=oper
+ , right={ty=ty, e=VAR t2}}}]}
+ end)
+
+ | ARR {size, init=SOME init} =>
+ let val t1 = tmpVar T.INT
+ val t2 = tmpVar typ
+ val t3 = tmpVar T.INT
+ in {ty=typ, e=SEQ
+ [ fix(unit(ASSIGN{var=t1, exp=size}))
+ , unit(ASSIGN{ var=t2
+ , exp={ty=typ
+ , e=ARR{ size={ty=T.INT, e=VAR t1}
+ , init=NONE}}})
+ , unit(WHILE{ test={ ty=T.INT
+ , e=OP{ left={ty=T.INT,e=VAR t3}
+ , oper=LT
+ , right={ty=T.INT,e=VAR t1}}}
+ , body=fix(unit(ASSIGN{ var=INDEX(t2, { ty=T.INT
+ , e=VAR t3})
+ , exp=init}))})
+ , {ty=typ, e=VAR t2}]}
+ end
+
+ | REC (SOME l) =>
+ let val t = tmpVar typ
+ fun foo (sym,{ty,e}) =
+ fix(unit(ASSIGN{var=(FIELD(t,sym)),exp={ty=ty,e=e}}))
+ val inits = ST.listItems (ST.mapi foo l)
+ in { ty=typ
+ , e=SEQ(List.concat[ [unit(ASSIGN{var=t, exp={ty=typ, e=REC NONE}})]
+ , inits
+ , [{ty=typ, e=VAR t}]])
+ }
+ end
+
+ | _ => te
+ end
+
+(* transform :: (program * blockname) -> program *)
+fun fromAlist l = foldl (fn((k,v),t)=>ST.insert(t,k,v)) ST.empty l
+fun transform (program:program,blockname:S.symbol):program =
+ let val vl = ref ([]:(S.symbol*T.ty)list)
+ val {main,blocks,procs,arrays,records,vars=pvars} = program
+ val {body,vars,args,subBlocks,up} = ST.lookup(#blocks program, blockname)
+ val body' = fix vl program body
+ val block' = {body=body',vars=List.concat[map #1 (!vl),vars],args=args,subBlocks=subBlocks,up=up}
+ val newvars =
+ fromAlist (map (fn(n,ty)=>(n,{typ=ty,block=blockname,ref'=false}))
+ (!vl))
+ val vars' = ST.unionWith (fn _=>fuck()) (newvars,pvars)
+ val blocks' = ST.insert(blocks,blockname,block')
+ in {main=main,blocks=blocks',procs=procs,arrays=arrays,records=records,vars=vars'}
+ end
(*
while (bad) do exp

0 comments on commit 68b7793

Please sign in to comment.
Something went wrong with that request. Please try again.