Commit d39898aa authored by Laszlo Domoszlai's avatar Laszlo Domoszlai
Browse files

add forgotten files

parent 3e666fbd
definition module Lifting
import Sapl.SaplStruct
// Returns True if a term can be inlined, i.e. no separate statement is needed
inline :: !SaplTerm -> Bool
prepareFun :: !FuncType -> FuncType
prepareExpr :: !SaplTerm -> SaplTerm
implementation module Lifting
import StdEnv
import Sapl.SaplStruct
inline :: !SaplTerm -> Bool
inline (SLet _ _) = False
inline (SCase cond [(PLit (LBool True), case1),(PLit (LBool False), case2)]) = inline cond && inline case1 && inline case2
inline (SCase cond [(PLit (LBool False), case1),(PLit (LBool True), case2)]) = inline cond && inline case1 && inline case2
inline (SCase _ _) = False
inline _ = True
prepareFun :: !FuncType -> FuncType
prepareFun (FTFunc name body args) = FTFunc name (prepareExpr body) args
prepareFun (FTCAF name body) = FTCAF name (prepareExpr body)
prepareFun ftype = ftype
:: LiftingState = {varidx :: Int}
prepareExpr :: !SaplTerm -> SaplTerm
prepareExpr t
# (t, st, defs) = walkTerm t {varidx = 1}
= case defs of
[] = t
defs = SLet t defs
walkTerm :: !SaplTerm !LiftingState -> (!SaplTerm, !LiftingState, ![SaplLetDef])
walkTerm c=:(SCase cond patterns) st
# (cond, st, defs) = walkTerm cond st
# (patterns, st) = walkPatterns patterns st
= case defs of
[] = (SCase cond patterns, st, [])
defs = (SCase (SLet cond defs) patterns, st, [])
walkTerm (SLet expr bindings) st
# (expr, st, edefs) = walkTerm expr st
# (bindings, st, bdefs) = walkBindings bindings st
# defs = edefs ++ bdefs
= case defs of
[] = (SLet expr bindings, st, [])
// New defs can be added to the end, they will be ordered later on
defs = (SLet expr (bindings ++ defs), st, [])
walkTerm (SSelect expr ty idx) st
# (expr, st, defs) = walkTerm expr st
= (SSelect expr ty idx, st, defs)
walkTerm (SApplication sel=:(SSelect sexpr _ _) args) st
# (letvar, st) = genVar st
# selvar = SVar (removeTypeInfo letvar)
# (args, st, defs) = walkArgs args st
= (SApplication selvar args, st, [SaplLetDef letvar sel:defs])
where
genVar {varidx} = (TypedVar (StrictVar ("$g"+++toString varidx) 0) NoType, {varidx = varidx + 1})
walkTerm (SApplication name args) st
# (args, st, defs) = walkArgs args st
= (SApplication name args, st, defs)
walkTerm t st = (t, st, [])
walkArgs [] st = ([], st, [])
walkArgs [t:ts] st
# (t, st, def) = walkTerm t st
# (ts, st, defs) = walkArgs ts st
= ([t:ts], st, def ++ defs)
walkPatterns [] st = ([], st)
walkPatterns [(p, t):ps] st
# (t, st, defs) = walkTerm t st
# t = case defs of
[] = t
defs = SLet t defs
# (ps, st) = walkPatterns ps st
= ([(p,t):ps], st)
walkBindings [] st = ([], st, [])
walkBindings [SaplLetDef var expr:bs] st
# (expr, st, def) = walkTerm expr st
# (bs, st, defs) = walkBindings bs st
= ([SaplLetDef var expr:bs], st, def ++ defs)
definition module Prims
import Data.Map
primMap :: Map String Int
implementation module Prims
import StdString
import Data.Map
primMap :: Map String Int
primMap =: fromList primList
primList = [
("addI", 2),
("subI", 2),
("multI", 2),
("divI", 2),
("gtI", 2),
("geI", 2),
("ltI", 2),
("eqI", 2),
("neqI", 2),
("bitxor", 2),
("bitand", 2),
("bitor", 2),
("bitnot", 2),
("shiftleft", 2),
("shiftright", 2),
("geC", 2),
("ltC", 2),
("eqC", 2),
("addR", 2),
("subR", 2),
("multR", 2),
("divR", 2),
("ltR", 2),
("eqR", 2),
("cos", 1),
("sin", 1),
("tan", 1),
("acos", 1),
("atan", 1),
("absR", 1),
("negR", 1),
("eqB", 2),
("not", 1),
("and", 2),
("or", 2),
("mod", 2),
("eqB", 2),
("not", 1),
("and", 2),
("or", 2),
("mod", 2),
("C2I", 1),
("R2I", 1),
("S2I", 1),
("I2C", 1),
("I2R", 1),
("R2R", 1),
("S2R", 1),
("array_create1", 1),
("array_create1_lazy", 1),
("array_create1_B_I", 1),
("array_create1_B_B", 1),
("array_create1_B_R", 1),
("array_create2", 2),
("array_create2_lazy", 2),
("array_create2_B_I", 2),
("array_create2_B_B", 2),
("array_create2_B_R", 2),
("array_update", 3),
("array_update_lazy", 3),
("array_update_B_I", 3),
("array_update_B_B", 3),
("array_update_B_R", 3),
("array_size", 1),
("array_size_lazy", 1),
("array_size_B_I", 1),
("array_size_B_B", 1),
("array_size_B_R", 1),
("array_select", 2),
("array_select_lazy", 2),
("array_select_B_I", 2),
("array_select_B_B", 2),
("array_select_B_R", 2),
("string_size", 1),
("string_select", 2),
("string_create1", 1),
("string_create2", 2),
("string_update", 3),
("string_update_copy", 3),
("string_slice", 3),
("string_append", 2),
("eqS", 2),
("ltS", 2),
("C2S", 1),
("I2S", 1),
("R2S", 1),
("_trace", 1),
("abort", 1)]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment