Commit 08110c68 authored by Laszlo Domoszlai's avatar Laszlo Domoszlai

fix lifting of embedded record updates

parent 3635602c
......@@ -2,7 +2,7 @@ definition module Sapl.Optimization.StrictnessPropagation
import Sapl.SaplParser, Sapl.Target.Flavour
:: IsStrictArgFun :== !ParserState !String !Int !Int -> Bool
:: IsStrictArgFun :== ParserState String Int Int -> Bool
// strict argument checker for Flavour file
isStrictArgFlavour :: !Flavour !ParserState !String !Int !Int -> Bool
......
......@@ -676,7 +676,7 @@ where
strictness = strictnessMap type s
isStrict idx = (strictness bitand (2 << idx)) > 0
// Should not happen, at thi spoint "update" is always at strict position
// Should not happen, at this point "update" is always at strict position
termCoder t=:(SUpdate _ _ _) s a
= a <++ "/* UPD */"
......@@ -807,7 +807,7 @@ generateJS f tramp saplsrc mbPst
= Ok (a, newpst)
Error msg = Error msg
where
upd :: (!String !Int !Int -> Bool) ([FuncType], Map String FuncType) FuncType -> ([FuncType], Map String FuncType)
upd :: (String Int Int -> Bool) ([FuncType], Map String FuncType) FuncType -> ([FuncType], Map String FuncType)
upd sf (nfs, genfuns) fun
= let (nfun, ngenfuns) = prepareFun sf fun genfuns in ([nfun:nfs], union genfuns ngenfuns)
......
......@@ -8,7 +8,7 @@ inline :: !SaplTerm -> Bool
// First function: decide on strictness. See doStrictnessPropagation
// Map: generated functions
prepareFun :: (!String !Int !Int -> Bool) !FuncType (Map String FuncType) -> (FuncType, Map String FuncType)
prepareExpr :: (!String !Int !Int -> Bool) !SaplTerm (Map String FuncType) -> (SaplTerm, Map String FuncType)
prepareFun :: (String Int Int -> Bool) !FuncType (Map String FuncType) -> (FuncType, Map String FuncType)
prepareExpr :: (String Int Int -> Bool) !SaplTerm (Map String FuncType) -> (SaplTerm, Map String FuncType)
......@@ -7,12 +7,12 @@ import Data.Map
inline :: !SaplTerm -> Bool
inline (SLet _ _) = False
inline (SUpdate _ _ _) = 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 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 :: (!String !Int !Int -> Bool) !FuncType (Map String FuncType) -> (FuncType, Map String FuncType)
prepareFun :: (String Int Int -> Bool) !FuncType (Map String FuncType) -> (FuncType, Map String FuncType)
prepareFun sf (FTFunc name body args) genfuns
# (body, genfuns) = prepareExpr sf body genfuns
= (FTFunc name body args,genfuns)
......@@ -37,7 +37,7 @@ where
mask [] bits = bits
mask [(idx,_):us] bits = mask us ((1 << idx) bitor bits)
prepareExpr :: (!String !Int !Int -> Bool) !SaplTerm (Map String FuncType) -> (SaplTerm, Map String FuncType)
prepareExpr :: (String Int Int -> Bool) !SaplTerm (Map String FuncType) -> (SaplTerm, Map String FuncType)
prepareExpr sf t genfuns
# (t, st, defs) = walkTerm t False True {varidx = 1, genfuns = genfuns}
= case defs of
......@@ -86,8 +86,8 @@ where
where
genVar st=:{varidx} = (TypedVar (StrictVar ("$g"+++toString varidx) 0) NoType, {st & varidx = varidx + 1})
walkTerm (SUpdate expr ty updates) False False st
# (expr, st, edefs) = walkTerm expr False False st
walkTerm (SUpdate expr ty updates) doNotLift False st
# (expr, st, edefs) = walkTerm expr doNotLift False st
# (updates, st, udefs) = walkUpdates updates st
// Generate new fun and lift it in the same time
# (genfun, _) = prepareFun sf (genUpdateFun (SUpdate expr ty updates)) newMap
......@@ -97,8 +97,9 @@ where
where
extractName (FTFunc (TypedVar name _) _ _) = name
walkTerm (SUpdate expr ty updates) _ strictPosition st
# (expr, st, edefs) = walkTerm expr False strictPosition st
// TODO: is it a real option?
walkTerm (SUpdate expr ty updates) True True st
# (expr, st, edefs) = walkTerm expr False True st
# (updates, st, udefs) = walkUpdates updates st
= (SUpdate expr ty updates, st, edefs ++ udefs)
......
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