fix lifting of embedded record updates

src/Sapl/Optimization/StrictnessPropagation.dcl

@@ -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

src/Sapl/Target/JS/CodeGeneratorJS.icl

@@ -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)
   		

src/Sapl/Target/JS/Lifting.dcl

@@ -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)
 
 

src/Sapl/Target/JS/Lifting.icl

@@ -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)