Home My Page Projects Code Snippets Project Openings diderot
 Summary Activity Tracker Tasks SCM

# SCM Repository

[diderot] Annotation of /trunk/src/compiler/simplify/simplify.sml
 [diderot] / trunk / src / compiler / simplify / simplify.sml

# Annotation of /trunk/src/compiler/simplify/simplify.sml

Revision 173 - (view) (download)

 1 : jhr 171 (* simplify.sml 2 : * 3 : * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu) 4 : * All rights reserved. 5 : * 6 : * Simplify the AST representation. 7 : *) 8 : 9 : structure Simplify : sig 10 : 11 : val transform : AST.program -> Simple.program 12 : 13 : end = struct 14 : 15 : structure Ty = Types 16 : structure S = Simple 17 : 18 : local 19 : val tempName = Atom.atom "_t" 20 : in 21 : fun newTemp ty = Var.new (tempName, AST.LocalVar, ty) 22 : end 23 : 24 : (* make a block out of a list of statements that are in reverse order *) 25 : fun mkBlock stms = let 26 : fun flatten [] = [] 27 : | flatten (S.S_Block stms :: r) = stms @ flatten r 28 : | flatten (stm :: r) = stm :: flatten r 29 : in 30 : S.S_Block(flatten (List.rev stms)) 31 : end 32 : 33 : fun transform (AST.Program dcls) = let 34 : val globals = ref [] 35 : val globalInit = ref [] 36 : val actors = ref [] 37 : fun simplifyDecl dcl = (case dcl 38 : of AST.D_Input(x, NONE) => globals := x :: !globals 39 : | AST.D_Input(x, SOME e) => let 40 : val (stms, e') = simplifyExp (e, []) 41 : in 42 : (* FIXME: note that we should add code to check for the input value overriding the default value *) 43 : globals := x :: !globals; 44 : globalInit := S.S_Assign(x, e') :: (stms @ !globalInit) 45 : end 46 : | AST.D_Var(AST.VD_Decl(x, e)) => let 47 : val (stms, e') = simplifyExp (e, []) 48 : in 49 : globals := x :: !globals; 50 : globalInit := S.S_Assign(x, e') :: (stms @ !globalInit) 51 : end 52 : | AST.D_Actor info => actors := simplifyActor info :: !actors 53 : | AST.D_InitialArray(e, iters) => () (* FIXME *) 54 : | AST.D_InitialCollection(e, iters) => () (* FIXME *) 55 : (* end case *)) 56 : in 57 : List.app simplifyDecl dcls; 58 : S.Prog{ 59 : globals = List.rev(!globals), 60 : globalInit = mkBlock (!globalInit), 61 : actors = List.rev(!actors) 62 : } 63 : end 64 : 65 : and simplifyActor {name, params, state, methods} = let 66 : fun simplifyState ([], xs, stms) = (List.rev xs, mkBlock stms) 67 : | simplifyState (AST.VD_Decl(x, e) :: r, xs, stms) = let 68 : val (stms, e') = simplifyExp (e, stms) 69 : in 70 : simplifyState (r, x::xs, S.S_Assign(x, e') :: stms) 71 : end 72 : val (xs, stm) = simplifyState (state, [], []) 73 : in 74 : S.Actor{ 75 : jhr 173 name = name, 76 : jhr 171 params = params, 77 : state = xs, stateInit = stm, 78 : methods = List.map simplifyMethod methods 79 : } 80 : end 81 : 82 : and simplifyMethod (AST.M_Method(name, body)) = 83 : S.M_Method(name, simplifyBlock body) 84 : 85 : (* simplify a statement into a single statement (i.e., a block if it expands into more 86 : * than one new statement. 87 : *) 88 : and simplifyBlock stm = mkBlock (simplifyStmt (stm, [])) 89 : 90 : and simplifyStmt (stm, stms) = (case stm 91 : of AST.S_Block body => let 92 : fun simplify ([], stms) = stms 93 : | simplify (stm::r, stms) = simplify (r, simplifyStmt (stm, stms)) 94 : in 95 : simplify (body, stms) 96 : end 97 : | AST.S_Decl(AST.VD_Decl(x, e)) => let 98 : val (stms, e') = simplifyExp (e, stms) 99 : in 100 : S.S_Assign(x, e') :: stms 101 : end 102 : | AST.S_IfThenElse(e, s1, s2) => let 103 : val (stms, x) = simplifyExpToVar (e, stms) 104 : val s1 = simplifyBlock s1 105 : val s2 = simplifyBlock s2 106 : in 107 : S.S_IfThenElse(x, s1, s2) :: stms 108 : end 109 : | AST.S_Assign(x, e) => let 110 : val (stms, e') = simplifyExp (e, stms) 111 : in 112 : S.S_Assign(x, e') :: stms 113 : end 114 : | AST.S_New(name, args) => let 115 : val (stms, xs) = simplifyExpsToVars (args, stms) 116 : in 117 : S.S_New(name, xs) :: stms 118 : end 119 : | AST.S_Die => S.S_Die :: stms 120 : | AST.S_Stabilize => S.S_Stabilize :: stms 121 : (* end case *)) 122 : 123 : and simplifyExp (exp, stms) = ( 124 : case exp 125 : of AST.E_Var x => (stms, S.E_Var x) 126 : | AST.E_Lit lit => (stms, S.E_Lit lit) 127 : | AST.E_Tuple es => raise Fail "E_Tuple not yet implemented" 128 : | AST.E_Apply(f, tyArgs, args, ty) => let 129 : val (stms, xs) = simplifyExpsToVars (args, stms) 130 : in 131 : (stms, S.E_Apply(f, tyArgs, xs, ty)) 132 : end 133 : | AST.E_Cons es => let 134 : val (stms, xs) = simplifyExpsToVars (es, stms) 135 : in 136 : (stms, S.E_Cons xs) 137 : end 138 : | AST.E_Cond(e1, e2, e3) => let 139 : (* a conditional expression gets turned into an if-then-else statememt *) 140 : val result = newTemp Ty.T_Bool 141 : val (stms, x) = simplifyExpToVar (e1, stms) 142 : fun simplifyBranch e = let 143 : val (stms, e) = simplifyExp (e, []) 144 : in 145 : mkBlock (S.S_Assign(result, e)::stms) 146 : end 147 : val s1 = simplifyBranch e1 148 : val s2 = simplifyBranch e2 149 : in 150 : (S.S_IfThenElse(x, s1, s2) :: stms, S.E_Var result) 151 : end 152 : (* end case *)) 153 : 154 : and simplifyExpToVar (exp, stms) = let 155 : val (stms, e) = simplifyExp (exp, stms) 156 : in 157 : case e 158 : of S.E_Var x => (stms, x) 159 : | _ => let 160 : val x = newTemp (S.typeOf e) 161 : in 162 : (S.S_Assign(x, e)::stms, x) 163 : end 164 : (* end case *) 165 : end 166 : 167 : and simplifyExpsToVars (exps, stms) = let 168 : fun f ([], xs, stms) = (stms, List.rev xs) 169 : | f (e::es, xs, stms) = let 170 : val (stms, x) = simplifyExpToVar (e, stms) 171 : in 172 : f (es, x::xs, stms) 173 : end 174 : in 175 : f (exps, [], stms) 176 : end 177 : 178 : end

 root@smlnj-gforge.cs.uchicago.edu ViewVC Help Powered by ViewVC 1.0.0