| 19 |
* while mapping the parameters to arguments. |
* while mapping the parameters to arguments. |
| 20 |
*) |
*) |
| 21 |
fun beta (lhs, S.Func{f, params, body}, args) = let |
fun beta (lhs, S.Func{f, params, body}, args) = let |
| 22 |
|
val needsLHSPreDecl = ref false (* set to true if the lhs needs to be declared before the body *) |
| 23 |
fun rename env x = (case V.Map.find(env, x) |
fun rename env x = (case V.Map.find(env, x) |
| 24 |
of SOME x' => x' |
of SOME x' => x' |
| 25 |
| NONE => if SimpleVar.isGlobal x |
| NONE => if SimpleVar.isGlobal x |
| 26 |
then x |
then x |
| 27 |
else raise Fail("unknown variable " ^ V.uniqueNameOf x) |
else raise Fail("unknown variable " ^ V.uniqueNameOf x) |
| 28 |
(* end case *)) |
(* end case *)) |
| 29 |
fun doBlock (env, S.Block stms) = let |
fun doBlock (env, isTop, S.Block stms) = let |
| 30 |
fun f (stm, (env, stms)) = let |
fun f (stm, (env, stms)) = let |
| 31 |
val (env, stm) = doStmt (env, stm) |
val (env, stm) = doStmt (env, isTop, stm) |
| 32 |
in |
in |
| 33 |
(env, stm::stms) |
(env, stm::stms) |
| 34 |
end |
end |
| 36 |
in |
in |
| 37 |
S.Block(List.rev stms) |
S.Block(List.rev stms) |
| 38 |
end |
end |
| 39 |
and doStmt (env, stm) = (case stm |
and doStmt (env, isTop, stm) = (case stm |
| 40 |
of S.S_Var x => let |
of S.S_Var x => let |
| 41 |
val x' = V.copy x |
val x' = V.copy x |
| 42 |
in |
in |
| 51 |
end |
end |
| 52 |
(* end case *)) |
(* end case *)) |
| 53 |
| S.S_IfThenElse(x, b1, b2) => |
| S.S_IfThenElse(x, b1, b2) => |
| 54 |
(env, S.S_IfThenElse(rename env x, doBlock(env, b1), doBlock(env, b2))) |
(env, S.S_IfThenElse(rename env x, doBlock(env, false, b1), doBlock(env, false, b2))) |
| 55 |
| S.S_New(strnd, xs) => (env, S.S_New(strnd, List.map (rename env) xs)) |
| S.S_New(strnd, xs) => (env, S.S_New(strnd, List.map (rename env) xs)) |
| 56 |
| S.S_Die => (env, stm) |
| S.S_Die => (env, stm) |
| 57 |
| S.S_Stabilize => (env, stm) |
| S.S_Stabilize => (env, stm) |
| 58 |
| S.S_Return x => (env, S.S_Assign(lhs, S.E_Var(rename env x))) |
| S.S_Return x => ( |
| 59 |
|
if not isTop then needsLHSPreDecl := true else (); |
| 60 |
|
(env, S.S_Assign(lhs, S.E_Var(rename env x)))) |
| 61 |
| S.S_Print xs => (env, S.S_Print(List.map (rename env) xs)) |
| S.S_Print xs => (env, S.S_Print(List.map (rename env) xs)) |
| 62 |
(* end case *)) |
(* end case *)) |
| 63 |
and doExp env exp = (case exp |
and doExp env exp = (case exp |
| 81 |
val env = ListPair.foldlEq |
val env = ListPair.foldlEq |
| 82 |
(fn (x, x', env) => V.Map.insert(env, x, x')) |
(fn (x, x', env) => V.Map.insert(env, x, x')) |
| 83 |
V.Map.empty (params, args) |
V.Map.empty (params, args) |
| 84 |
|
val blk as S.Block stms = doBlock (env, true, body) |
| 85 |
in |
in |
| 86 |
doBlock (env, body) |
if !needsLHSPreDecl |
| 87 |
|
then S.Block(S.S_Var lhs :: stms) |
| 88 |
|
else blk |
| 89 |
end |
end |
| 90 |
|
|
| 91 |
(* inline expand user-function calls in a block *) |
(* inline expand user-function calls in a block *) |
| 112 |
|
|
| 113 |
fun expandFunc funcTbl (S.Func{f, params, body}) = let |
fun expandFunc funcTbl (S.Func{f, params, body}) = let |
| 114 |
val body' = expandBlock funcTbl body |
val body' = expandBlock funcTbl body |
| 115 |
|
val func' = S.Func{f=f, params=params, body=body'} |
| 116 |
in |
in |
| 117 |
V.Tbl.insert funcTbl (f, S.Func{f=f, params=params, body=body'}) |
V.Tbl.insert funcTbl (f, func') |
| 118 |
end |
end |
| 119 |
|
|
| 120 |
fun expandStrand funcTbl = let |
fun expandStrand funcTbl = let |
Parent Directory
| 
Revision Log
| 
Patch
