Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

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

  • Loading branch information...
commit 68b779375e70c298fc07cf3123f8e6d40a073343 2 parents 5067f4d + db813bd
Benjamin Travis Summers authored

Showing 3 changed files with 229 additions and 100 deletions. Show diff stats Hide diff stats

  1. +10 0 TODO
  2. +93 2 src/ir.sml
  3. +126 98 src/toc.sml
10 TODO
@@ -20,3 +20,13 @@
20 20
21 21 :TODO: Write a makefile rule to run the each-file-on-a-line tests
22 22 cat ex/small_valid | (i=0; while read x; do echo "%% $x"; echo $x | ./o.parse; done) | less
  23 +
  24 +:TODO: Some style stuff
  25 + - IR.#ref' vs CIR.#isRef
  26 + - Functional record update
  27 + - Fold in {src/ll.sml}
  28 +
  29 +:TODO: Lexer bug
  30 + `4*5' works, but `4 * 5' doesn't
  31 +
  32 +:TODO: IR -> CIR
95 src/ir.sml
@@ -44,8 +44,8 @@ structure IR = struct
44 44 withtype texp = {e:exp, ty:Type.ty}
45 45
46 46 (*
47   - The `block' field in `vars' refers to where the block where a
48   - variable is defined or the block defined by a function depending
  47 + The `block' field in `vars' refers to where the block where a
  48 + variable is defined or the block defined by a function depending
49 49 on what type of variable it is. Note that `args' and `vars'
50 50 are disjoint sets and that the order of `args' is significant.
51 51 *)
@@ -68,3 +68,94 @@ structure IR = struct
68 68 , vars:vars
69 69 }
70 70 end
  71 +
  72 +
  73 +structure IRSexp = struct
  74 + local
  75 + structure S = Sexp
  76 + open IR
  77 + structure T = Type
  78 + structure U = Util
  79 + val name = Symbol.unique
  80 + fun sym s = s
  81 + val fix = S.SYM o name
  82 + fun sexp s args = S.SEQ (S.SYM s::args)
  83 +
  84 + fun opname oper = case oper
  85 + of ADD => "+" | SUB => "-" | MUL => "*" | DIV => "/" | EQ => "="
  86 + | NEQ => "<>" | LT => "<" | LE => "<=" | GT => ">" | GE => ">="
  87 + | AND => "&" | OR => "|"
  88 +
  89 + fun expSexp e = case e
  90 + of ARR {size,init} => (case init
  91 + of SOME init => sexp "array" [texpSexp size, texpSexp init]
  92 + | NONE => S.SYM "array")
  93 + | ASSIGN {var=v,exp=e'} => sexp "assign" (varSexp v::[texpSexp e'])
  94 + | BREAK => sexp "break" []
  95 + | CALL {func:Symbol.symbol, args:texp list ref} => sexp "call" (fix func::map texpSexp (!args))
  96 + | IF {test,then'} => sexp "if" [texpSexp test, texpSexp then']
  97 + | IFELSE {test,then',else'} => sexp "ifelse" (map texpSexp [test,then',else'])
  98 + | INT i => sexp "int" [S.INT i]
  99 + | NIL => sexp "nil" []
  100 + | OP {left, oper, right} => sexp "op" (S.SYM(opname oper)::[texpSexp left, texpSexp right])
  101 + | REC l => (case l
  102 + of SOME l => sexp "rec"
  103 + (map (fn (s, te) => S.SEQ [fix s,texpSexp te])
  104 + (SymTable.listItemsi l))
  105 + | NONE => S.SYM "rec")
  106 + | SEQ l => sexp "seq" (map texpSexp l)
  107 + | STR s => sexp "str" [S.STR s]
  108 + | VAR v => varSexp v
  109 + | WHILE {test,body} => sexp "while" [texpSexp test,texpSexp body]
  110 +
  111 + and varSexp v = case v
  112 + of SIMPLE s => sexp "simple-var" [fix s]
  113 + | FIELD (v,s) => sexp "field-var" [varSexp v,fix s]
  114 + | INDEX (v,te) => sexp "index-var" [varSexp v,texpSexp te]
  115 +
  116 + and typSexp ty = case ty
  117 + of T.INT => sexp "type" [S.SYM "INT"]
  118 + | T.STR => sexp "type" [S.SYM "STR"]
  119 + | T.NIL => sexp "type" [S.SYM "NIL"]
  120 + | T.REC s => sexp "type" [S.SYM "record", fix s]
  121 + | T.ARR s => sexp "type" [S.SYM "array", fix s]
  122 +
  123 + and texpSexp (te as {e,ty}) = sexp "texp" [typSexp ty, expSexp e]
  124 +
  125 + and blockSexp (s,(b as {args,vars,subBlocks,up,body})) =
  126 + sexp "block" [ fix s
  127 + , sexp "args" (map fix args)
  128 + , sexp "vars" (map fix vars)
  129 + , sexp "subBlocks" (map fix subBlocks)
  130 + , sexp "up" (case up of SOME up' => [fix up'] | NONE => [] )
  131 + , sexp "body" [texpSexp body]
  132 + ]
  133 +
  134 + and procSexp (s,(p as {res,args})) =
  135 + sexp (name s) [typSexp res, sexp "args" (map typSexp args)]
  136 +
  137 + and arraySexp (s,a) = sexp (name s) [typSexp a]
  138 +
  139 + and recordSexp (s,r) =
  140 + sexp (name s) (map (fn(s,typ)=>S.SEQ[fix s,typSexp typ])
  141 + (SymTable.listItemsi r))
  142 +
  143 + and varSexp' (s, (v as {typ,block:Symbol.symbol,ref'})) =
  144 + sexp (name s) [typSexp typ, fix block, S.BOOL ref']
  145 +
  146 +
  147 + val x = {ty=T.INT,e=OP{oper=ADD,left={ty=T.INT, e=STR "3"}, right={ty=T.INT,e=INT 4}}}
  148 + val () = S.printSexp(texpSexp x);
  149 +
  150 + in
  151 + fun programSexp (p:program as {main,blocks,procs,arrays,records,vars}) =
  152 + sexp "program" [fix main
  153 + , sexp "blocks" (map blockSexp (SymTable.listItemsi blocks))
  154 + , sexp "procs" (map procSexp (SymTable.listItemsi procs))
  155 + , sexp "array" (map arraySexp (SymTable.listItemsi arrays))
  156 + , sexp "records" (map recordSexp(SymTable.listItemsi records))
  157 + , sexp "vars" (map varSexp' (SymTable.listItemsi vars))
  158 + ]
  159 +
  160 + end
  161 +end
224 src/toc.sml
... ... @@ -1,10 +1,10 @@
1 1 open IR
2 2 open Util
3 3 structure T=Type
  4 +structure S=Symbol
4 5
5 6 val tmp = Symbol.mk "tmp"
6   -(* TODO this should insert the new variable into the current block *)
7   -fun tmpVar ty = SIMPLE(Symbol.gensym tmp)
  7 +
8 8 fun unit e = {ty=T.UNIT,e=e}
9 9 fun seq el = unit(SEQ(el))
10 10
@@ -42,102 +42,130 @@ and expClass (texp as {ty,e}) = case e
42 42 | WHILE {test,body} =>
43 43 if okExp test andalso okStmt body then STMT else BAD
44 44
45   -fun fix (te as {e=exp,ty=typ}) = case exp
46   - of WHILE {test=test,body=body} =>
47   - if okExp test then unit(WHILE{test=test,body=(fix body)})
48   - else let val t = tmpVar T.INT
49   - val updateTest = fix(unit(ASSIGN{var=t,exp=test}))
50   - in seq[ updateTest
51   - , unit(WHILE{ test={ty=T.INT,e=VAR t}
52   - , body=seq[fix body, updateTest]
53   - })]
54   - end
55   -
56   - | SEQ l => {ty=typ,e=SEQ (map fix l)}
57   -
58   - | ASSIGN {var,exp as {ty,e}} =>
59   - (case e
60   - of (SEQ el) =>
61   - (case splitForLast el of (prefix,last) =>
62   - fix({ty=ty,e=SEQ(List.concat
63   - [prefix,
64   - [{ ty=ty
65   - , e=ASSIGN{var=var,exp=last}
66   - }]])}))
67   - | (IFELSE{test,then',else'}) =>
68   - fix(unit(IFELSE{ test=test
69   - , then'=unit(ASSIGN{var=var, exp=then'})
70   - , else'=unit(ASSIGN{var=var, exp=else'})
71   - }))
72   - | _ => if okExp exp then te else fix(unit((ASSIGN{var=var, exp=(fix exp)}))))
73   -
74   - | CALL {func, args=(ref args)} =>
75   - let val tmps = map (fn{ty,e}=>(ty,e,tmpVar ty)) args
76   - val args = map (fn(ty,_,v)=>{ty=ty,e=VAR v}) tmps
77   - val setup = map (fn(ty,e,v)=>unit(ASSIGN{var=v,exp={e=e,ty=ty}}))
78   - tmps
79   - in {ty=typ,e=SEQ
80   - [ seq setup
81   - , {ty=typ,e=CALL{func=func,args=ref args}}
82   - ]}
83   - end
84   -
85   - | IF {test, then'} =>
86   - fix(unit(IFELSE{test=test, then'=then', else'=(unit (SEQ []))}))
87   -
88   - | IFELSE {test, then', else'} =>
89   - let val t = tmpVar T.INT
90   - in {ty=typ, e=SEQ[ fix(unit(ASSIGN{var=t, exp=test}))
91   - , {ty=typ, e=IFELSE{ test={ty=T.INT, e=VAR t}
92   - , then'=fix(then')
93   - , else'=fix(else')}}]}
94   - end
95   -
96   - | OP {left, oper, right} =>
97   - (case left of {ty, e} =>
98   - let val t1 = tmpVar ty
99   - val t2 = tmpVar ty
100   - in {ty=typ, e=SEQ
101   - [ fix(unit(ASSIGN{var=t1, exp=left}))
102   - , fix(unit(ASSIGN{var=t2, exp=right}))
103   - , { ty=typ, e=OP{ left={ty=ty, e=VAR t1}
104   - , oper=oper
105   - , right={ty=ty, e=VAR t2}}}]}
106   - end)
107   -
108   - | ARR {size, init=SOME init} =>
109   - let val t1 = tmpVar T.INT
110   - val t2 = tmpVar typ
111   - val t3 = tmpVar T.INT
112   - in {ty=typ, e=SEQ
113   - [ fix(unit(ASSIGN{var=t1, exp=size}))
114   - , unit(ASSIGN{ var=t2
115   - , exp={ty=typ
116   - , e=ARR{ size={ty=T.INT, e=VAR t1}
117   - , init=NONE}}})
118   - , unit(WHILE{ test={ ty=T.INT
119   - , e=OP{ left={ty=T.INT,e=VAR t3}
120   - , oper=LT
121   - , right={ty=T.INT,e=VAR t1}}}
122   - , body=fix(unit(ASSIGN{ var=INDEX(t2, { ty=T.INT
123   - , e=VAR t3})
124   - , exp=init}))})
125   - , {ty=typ, e=VAR t2}]}
126   - end
127   -
128   - | REC (SOME l) =>
129   - let val t = tmpVar typ
130   - fun foo (sym,{ty,e}) =
131   - fix(unit(ASSIGN{var=(FIELD(t,sym)),exp={ty=ty,e=e}}))
132   - val inits = ST.listItems (ST.mapi foo l)
133   - in { ty=typ
134   - , e=SEQ(List.concat[ [unit(ASSIGN{var=t, exp={ty=typ, e=REC NONE}})]
135   - , inits
136   - , [{ty=typ, e=VAR t}]])
137   - }
138   - end
139   -
140   - | _ => te
  45 +fun push vl e = vl:=(e::(!vl))
  46 +
  47 +(* fix :: (sym*ty) list ref -> (program * texp) -> (program * texp) *)
  48 +fun fix vl p (te as {e=exp,ty=typ}) =
  49 + let val fix = fix vl p
  50 + fun tmpVar ty =
  51 + let val sym = Symbol.gensym tmp
  52 + val () = push vl (sym,ty)
  53 + in SIMPLE sym
  54 + end
  55 + in case exp
  56 +
  57 + of WHILE {test=test,body=body} =>
  58 + if okExp test then unit(WHILE{test=test,body=(fix body)})
  59 + else let val t = tmpVar T.INT
  60 + val updateTest = fix(unit(ASSIGN{var=t,exp=test}))
  61 + in seq[ updateTest
  62 + , unit(WHILE{ test={ty=T.INT,e=VAR t}
  63 + , body=seq[fix body, updateTest]
  64 + })]
  65 + end
  66 +
  67 + | SEQ l => {ty=typ,e=SEQ (map fix l)}
  68 +
  69 + | ASSIGN {var,exp as {ty,e}} =>
  70 + (case e
  71 + of (SEQ el) =>
  72 + (case splitForLast el of (prefix,last) =>
  73 + fix({ty=ty,e=SEQ(List.concat
  74 + [prefix,
  75 + [{ ty=ty
  76 + , e=ASSIGN{var=var,exp=last}
  77 + }]])}))
  78 + | (IFELSE{test,then',else'}) =>
  79 + fix(unit(IFELSE{ test=test
  80 + , then'=unit(ASSIGN{var=var, exp=then'})
  81 + , else'=unit(ASSIGN{var=var, exp=else'})
  82 + }))
  83 + | _ => if okExp exp then te else fix(unit((ASSIGN{var=var, exp=(fix exp)}))))
  84 +
  85 + | CALL {func, args=(ref args)} =>
  86 + let val tmps = map (fn{ty,e}=>(ty,e,tmpVar ty)) args
  87 + val args = map (fn(ty,_,v)=>{ty=ty,e=VAR v}) tmps
  88 + val setup = map (fn(ty,e,v)=>unit(ASSIGN{var=v,exp={e=e,ty=ty}}))
  89 + tmps
  90 + in {ty=typ,e=SEQ
  91 + [ seq setup
  92 + , {ty=typ,e=CALL{func=func,args=ref args}}
  93 + ]}
  94 + end
  95 +
  96 + | IF {test, then'} =>
  97 + fix(unit(IFELSE{test=test, then'=then', else'=(unit (SEQ []))}))
  98 +
  99 + | IFELSE {test, then', else'} =>
  100 + let val t = tmpVar T.INT
  101 + in {ty=typ, e=SEQ[ fix(unit(ASSIGN{var=t, exp=test}))
  102 + , {ty=typ, e=IFELSE{ test={ty=T.INT, e=VAR t}
  103 + , then'=fix(then')
  104 + , else'=fix(else')}}]}
  105 + end
  106 +
  107 + | OP {left, oper, right} =>
  108 + (case left of {ty, e} =>
  109 + let val t1 = tmpVar ty
  110 + val t2 = tmpVar ty
  111 + in {ty=typ, e=SEQ
  112 + [ fix(unit(ASSIGN{var=t1, exp=left}))
  113 + , fix(unit(ASSIGN{var=t2, exp=right}))
  114 + , { ty=typ, e=OP{ left={ty=ty, e=VAR t1}
  115 + , oper=oper
  116 + , right={ty=ty, e=VAR t2}}}]}
  117 + end)
  118 +
  119 + | ARR {size, init=SOME init} =>
  120 + let val t1 = tmpVar T.INT
  121 + val t2 = tmpVar typ
  122 + val t3 = tmpVar T.INT
  123 + in {ty=typ, e=SEQ
  124 + [ fix(unit(ASSIGN{var=t1, exp=size}))
  125 + , unit(ASSIGN{ var=t2
  126 + , exp={ty=typ
  127 + , e=ARR{ size={ty=T.INT, e=VAR t1}
  128 + , init=NONE}}})
  129 + , unit(WHILE{ test={ ty=T.INT
  130 + , e=OP{ left={ty=T.INT,e=VAR t3}
  131 + , oper=LT
  132 + , right={ty=T.INT,e=VAR t1}}}
  133 + , body=fix(unit(ASSIGN{ var=INDEX(t2, { ty=T.INT
  134 + , e=VAR t3})
  135 + , exp=init}))})
  136 + , {ty=typ, e=VAR t2}]}
  137 + end
  138 +
  139 + | REC (SOME l) =>
  140 + let val t = tmpVar typ
  141 + fun foo (sym,{ty,e}) =
  142 + fix(unit(ASSIGN{var=(FIELD(t,sym)),exp={ty=ty,e=e}}))
  143 + val inits = ST.listItems (ST.mapi foo l)
  144 + in { ty=typ
  145 + , e=SEQ(List.concat[ [unit(ASSIGN{var=t, exp={ty=typ, e=REC NONE}})]
  146 + , inits
  147 + , [{ty=typ, e=VAR t}]])
  148 + }
  149 + end
  150 +
  151 + | _ => te
  152 + end
  153 +
  154 +(* transform :: (program * blockname) -> program *)
  155 +fun fromAlist l = foldl (fn((k,v),t)=>ST.insert(t,k,v)) ST.empty l
  156 +fun transform (program:program,blockname:S.symbol):program =
  157 + let val vl = ref ([]:(S.symbol*T.ty)list)
  158 + val {main,blocks,procs,arrays,records,vars=pvars} = program
  159 + val {body,vars,args,subBlocks,up} = ST.lookup(#blocks program, blockname)
  160 + val body' = fix vl program body
  161 + val block' = {body=body',vars=List.concat[map #1 (!vl),vars],args=args,subBlocks=subBlocks,up=up}
  162 + val newvars =
  163 + fromAlist (map (fn(n,ty)=>(n,{typ=ty,block=blockname,ref'=false}))
  164 + (!vl))
  165 + val vars' = ST.unionWith (fn _=>fuck()) (newvars,pvars)
  166 + val blocks' = ST.insert(blocks,blockname,block')
  167 + in {main=main,blocks=blocks',procs=procs,arrays=arrays,records=records,vars=vars'}
  168 + end
141 169
142 170 (*
143 171 while (bad) do exp

0 comments on commit 68b7793

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