compiler to the new SAPL

src/Sapl/Optimization/StrictnessPropagation.icl

@@ -47,8 +47,13 @@ propBody ps flavour sd body = walk sd body
 where
 	walk sd t=:(SVar var) = (insert (unpackVar var) sd, t)
 
-	walk sd t=:(SApplication var args)
-		// We can skip the new args, cannot contain let definitions...
+    // We can skip the new expr, cannot contain let definitions...
+	walk sd t=:(SSelect expr idx) 
+		# (sd, _) = walk sd expr
+		= (sd, t)
+
+    // We can skip the new args, cannot contain let definitions...
+	walk sd t=:(SApplication (SVar var) args)
 		# nsds = map fst (map (walk newSet) strictArgs)
 		= (unions [sd:nsds], t)
 	where
@@ -57,16 +62,17 @@ where
 		checkArg (arg, i) = isStrictArg ps flavour varName nr_args i
 		strictArgs = map fst (filter checkArg (zip2 args [0..]))
 
-	walk sd (SIf c l r) 
-		# (sdl, nl) = walk newSet l
-		# (sdr, nr) = walk newSet r		
-		# (sdc, nc) = walk sd c
-		= (union sdc (intersection sdl sdr), SIf nc nl nr)
+    // We can skip the new expr, cannot contain let definitions...
+    // Args cannot be checked, we do not know the function defiition...
+	walk sd t=:(SApplication expr args)
+		// expr is always strict
+		# (sd, _) = walk sd expr
+		= (sd, t)
 
-	walk sd (SSelect p cases) 
+	walk sd (SCase p cases) 
 		# (sdp, np) = walk sd p
 		# (sdcs, ncases) = unzip (map walkcase cases)
-		= (union sdp (intersections sdcs), SSelect np ncases)
+		= (union sdp (intersections sdcs), SCase np ncases)
 	where
 		walkcase (p, c) 
 			# (sd, nc) = walk newSet c 
@@ -89,7 +95,7 @@ where
 		where
 			vn = unpackVar (unpackBindVar bnd)
 
-			// Delete itself, it dosn't need any more
+			// Delete itself, it doesn't need any more
 			walkbnd sd (SaplLetDef (TypedVar (StrictVar vn _) _) body) = delete vn (fst (walk sd body)) // skip new body, it cannot be a let definition
 			walkbnd sd (SaplLetDef (TypedVar (NormalVar vn _) _) body) = delete vn sd
 		

src/Sapl/SaplParser.dcl

@@ -49,4 +49,3 @@ parseExpr :: [PosToken] -> MaybeError ErrorMsg (SaplTerm, ParserState)
 * @return merged parser state
 */
 mergeParserStates :: ParserState (Maybe ParserState) -> ParserState
-			

src/Sapl/SaplParser.icl

@@ -63,98 +63,110 @@ where
 
 addTupleCons _ = returnS Void
 
-factor [TIdentifier name:ts] = getLevel >>= \level = returnS (Just (SVar (NormalVar name level)), ts)
-factor [TLit lit:ts] = returnS (Just (SLit lit), ts)
-factor [TOpenParenthesis:ts] = 
-				application ts
+read_int [TLit (LInt lit):ts] = returnS (Just lit, ts)
+read_int ts = returnS (Nothing, ts)
+
+expr [TOpenParenthesis:ts] = 
+				mexpr ts
 			>>=	\(t, ts) = case hd ts of
 						TCloseParenthesis = returnS (Just t, tl ts)
-										  = returnE (ts, "Missing close parenthesis")
-factor ts = returnS (Nothing, ts)
+										  = returnE (ts, "Missing close parenthesisx")
 
-application [TOpenParenthesis:ts] = 
-				application ts
-			>>=	\(t, ts) = case hd ts of
-						TCloseParenthesis = returnS (t, tl ts)
-										  = returnE (ts, "Missing close parenthesis")
+expr [TLit lit:ts] = returnS (Just (SLit lit), ts)
 
-application [TIdentifier name:ts] = 
+expr [TIdentifier name:ts] = 
 				getLevel
 			>>= \level = returnS (NormalVar name level)
 			>>= \t = addTupleCons name
-			>>= \_ = args_factor ts
+			>>= \_ = args_expr ts
 			>>= \(as, ts) = case as of
-								[] = returnS (SVar t, ts) // !!!
-								   = returnS (SApplication t as, ts)
-
-application [TLit lit:ts] = returnS (SLit lit, ts)
-application ts = returnE (ts, "Invalid application")
-
-selectexpr [TIfKeyword:ts] = 
-				arg_adv ts 
-			>>= mandatory "Missing predicate"
-			>>= \(pred, ts) = arg_adv ts
-			>>= mandatory "Missing left hand side"
-			>>= \(lhs, ts) = arg_adv ts
-			>>= mandatory "Missing right hand side"			
-			>>= \(rhs, ts) = returnS (Just (SIf pred lhs rhs), ts)
-				
-selectexpr [TSelectKeyword:ts] = 
-				arg_adv ts
-			>>= mandatory "Missing select expression"				
-			>>= \(expr, ts) = args_pattern ts
-			>>= \(ps, ts) = if (isEmpty ps) 
-							   (returnE (ts, "Missing select patterns"))
-							   (returnS (Just (SSelect expr ps), ts))
-			
-selectexpr ts = returnS (Nothing, ts)
+								[] = returnS (Just (SVar t), ts)
+								   = returnS (Just (SApplication (SVar t) as), ts)
+
+expr [TSelectKeyword:ts] = 
+				sexpr ts 
+			>>= mandatory "Missing select expression"
+			>>= \(expr, ts) = read_int ts
+			>>= mandatory "Missing select index"
+			>>= \(idx, ts) = args_expr ts
+			>>= \(as, ts) = case as of
+								[] = returnS (Just (SSelect expr idx), ts)
+								   = returnS (Just (SApplication (SSelect expr idx) as), ts)
+
+expr ts = returnS (Nothing, ts)
+
+sexpr [TOpenParenthesis:ts] = 
+				mexpr ts
+			>>=	\(t, ts) = case hd ts of
+						TCloseParenthesis = returnS (Just t, tl ts)
+										  = returnE (ts, "Missing close parenthesisx")
 
-mainexpr ts = selectexpr ts 
-			>>= \(t, ts) = case t of
-								Just t = returnS (t, ts)
-						   			   = application ts
+sexpr [TLit lit:ts] = returnS (Just (SLit lit), ts)
+
+sexpr [TIdentifier name:ts] = 
+				getLevel
+			>>= \level = returnS (NormalVar name level)
+			>>= \t = addTupleCons name
+			>>= \_ = returnS (Just (SVar t), ts)
+
+sexpr ts = returnS (Nothing, ts)
+
+mexpr ts = expr ts >>= mandatory "Missing expression"
 
 letdefinitions ts = letdef_1 ts []
 where
 	letdef_1 [TIdentifier name, TTypeDef, TIdentifier type, TAssignmentOp:ts] as = 
 				getLevel
-			>>= \level = application ts 
+			>>= \level = body False ts 
 			>>= \(t, ts) = letdef_2 ts [SaplLetDef (TypedVar (NormalVar name level) (Type type)) t:as]
 	letdef_1 [TIdentifier name, TAssignmentOp:ts] as = 
 				getLevel
-			>>= \level = application ts 
+			>>= \level = body False ts 
 			>>= \(t, ts) = letdef_2 ts [SaplLetDef (TypedVar (NormalVar name level) NoType) t:as]
 	letdef_1 [TStrictIdentifier name, TTypeDef, TIdentifier type, TAssignmentOp:ts] as = 
 				getLevel
-			>>= \level = application ts 
+			>>= \level = body False ts 
 			>>= \(t, ts) = letdef_2 ts [SaplLetDef (TypedVar (StrictVar name level) (Type type)) t:as]			
 	letdef_1 [TStrictIdentifier name, TAssignmentOp:ts] as = 
 				getLevel
-			>>= \level = application ts 
+			>>= \level = body False ts 
 			>>= \(t, ts) = letdef_2 ts [SaplLetDef (TypedVar (StrictVar name level) NoType) t:as]
 	letdef_1 ts as = returnE (ts, "Invalid \"let\" definition")
 	letdef_2 [TColon: ts] as = letdef_1 ts as
 	letdef_2 ts as = returnS (reverse as, ts)
 
-body [TLetKeyword:ts] =
+body simple [TOpenParenthesis:ts] = 
+				body False ts
+			>>=	\(t, ts) = case hd ts of
+						TCloseParenthesis = returnS (t, tl ts)
+										  = returnE (ts, "Missing close parenthesis")
+
+body simple [TLetKeyword:ts] =
 				incLevel ts
 			>>= \ts = letdefinitions ts
 			>>= \(ds, ts) = case hd ts of
 					TInKeyword = returnS (tl ts)
 							   = returnE (ts, "Missing \"in\" keyword")
-			>>= \ts = mainexpr ts
+			>>= \ts = body False ts
 			>>= \(t, ts) = returnS (SLet t ds, ts)
 			>>= decLevel
+
+body simple [TCaseKeyword:ts] = 
+				body True ts		
+			>>= \(expr, ts) = args_pattern ts
+			>>= \(ps, ts) = if (isEmpty ps) 
+							   (returnE (ts, "Missing case patterns"))
+							   (returnS (SCase expr ps, ts))
 	
-body [TOpenBracket:ts] = skip ts	// ABC code: skip it	
+body simple [TOpenBracket:ts] = skip ts	// ABC code: skip it	
 where
 	skip [TCloseBracket:ts] = returnS (SAbortBody, ts)
 	skip [] = returnE ([], "Missing close bracket in ABC code definition")
 	skip [t:ts] = skip ts
 			
-body ts = mainexpr ts
+body simple ts = ((if simple sexpr expr) ts) >>= mandatory "Missing expression"
 
-args_factor ts = args_ factor ts
+args_expr ts = args_ sexpr ts
 args_pattern ts = args_ arg_pattern ts
 
 args_ f ts = args` ts []
@@ -166,36 +178,28 @@ where
 
 arg_pattern [TOpenParenthesis:TLit lit:ts] =
 			case hd ts of
-				TSelectAssignmentOp = body (tl ts)
+				TCaseAssignmentOp = body False (tl ts)
 							  = returnE (ts, "Missing select assignment operator")
 		>>=	\(t, ts) = case hd ts of
 				TCloseParenthesis = returnS (Just (PLit lit, t), tl ts)
-							  = returnE (ts, "Missing close parenthesis")
+							  = returnE (ts, "Missing close parenthesis3")
 
 arg_pattern [TOpenParenthesis:TIdentifier cons:ts] =
 			incLevel ts
 		>>= \ts = addTupleCons cons
 		>>= \_ = args ts
 		>>= \(as, ts) = case hd ts of
-				TSelectAssignmentOp = body (tl ts)
+				TCaseAssignmentOp = body False (tl ts)
 							  = returnE (ts, "Missing select assignment operator")
 		>>=	\(t, ts) = case hd ts of
 				TCloseParenthesis = returnS (Just (mbCons as, t), tl ts)
-							  = returnE (ts, "Missing close parenthesis")
+							  = returnE (ts, "Missing close parenthesis4")
 		>>= decLevel
 where
 	mbCons as = if (cons=="_") PDefault (PCons cons as)
 
 arg_pattern ts = returnS (Nothing, ts)
 
-arg_adv [TOpenParenthesis:ts] = 
-				body ts >>= \(t, ts) = returnS (Just t, ts)
-			>>=	\(t, ts) = case hd ts of
-						TCloseParenthesis = returnS (t, tl ts)
-										  = returnE (ts, "Missing close parenthesis")
-		
-arg_adv ts = factor ts
-
 args ts = args_ ts []
 where
 	args_ [TIdentifier name:ts] as = getLevel >>= \level = args_ ts [NormalVar name level:as] 
@@ -258,7 +262,7 @@ func ts = returnE (ts, "Not a function or type definition")
 
 typed_caf name type ts =
 				getLevel
-			>>= \level = body ts
+			>>= \level = body False ts
 			>>= \(t, ts) = addCAF (NormalVar name level) >>= \tname = returnS (FTCAF (TypedVar tname type) t, ts)
 
 typed_fun name type ts =
@@ -268,7 +272,7 @@ typed_fun name type ts =
 					TAssignmentOp	   = returnS (True, tl ts)
 					TMacroAssignmentOp = returnS (False, tl ts)					
 									   = returnE (ts, "Missing assignment operator")
-			>>= \(func, ts) = body ts 
+			>>= \(func, ts) = body False ts 
 			>>= \(t, ts) = if func 
 							(addFunction (NormalVar name level) as >>= \tname = returnS (FTFunc (TypedVar tname type) t as, ts))
 							(addFunction (NormalVar name level) as >>= \tname = returnS (FTMacro (TypedVar tname type) t as, ts))
@@ -297,7 +301,7 @@ where
 parseExpr :: [PosToken] -> MaybeError ErrorMsg (SaplTerm,ParserState)		
 parseExpr pts 
 	# ts = map (\(PosToken _ _ t) = t) pts
-	= case (body ts) defaultState of
+	= case (body False ts) defaultState of
 				Ok ((fts, _),ps) = Ok (fts,ps)
 				Error (ts, msg)  = let (lp, cp) = findpos ts in Error (msg+++" at line "+++toString lp+++" before charachter "+++toString cp)
 where

src/Sapl/SaplStruct.dcl

@@ -17,11 +17,10 @@ import Data.Maybe
 
 :: SaplTerm = SLit Literal
 			| SVar SaplVar
-			| SApplication SaplVar [SaplTerm]
-			| SIf SaplTerm SaplTerm SaplTerm
-			| SSelector SaplTerm
-			| SSelect SaplTerm [(SaplPattern, SaplTerm)]
+			| SApplication SaplTerm [SaplTerm]
+			| SCase SaplTerm [(SaplPattern, SaplTerm)]
 			| SLet SaplTerm [SaplLetDef]
+			| SSelect SaplTerm Int
 			| SAbortBody			
 
 :: SaplLetDef = SaplLetDef SaplTypedVar SaplTerm
@@ -67,6 +66,7 @@ instance unpackVar SaplVar
 instance unpackVar SaplTypedVar
 
 unpackBindVar  :: !SaplLetDef -> SaplTypedVar
+unpackBindExpr :: !SaplLetDef -> SaplTerm
 unpackConsName :: !SaplPattern -> Maybe String
 toStrictBind   :: !SaplLetDef -> SaplLetDef
 

src/Sapl/SaplStruct.icl

@@ -86,6 +86,9 @@ where
 unpackBindVar :: !SaplLetDef -> SaplTypedVar
 unpackBindVar (SaplLetDef typedVar _) = typedVar
 
+unpackBindExpr :: !SaplLetDef -> SaplTerm
+unpackBindExpr (SaplLetDef _ expr) = expr
+
 unpackConsName :: !SaplPattern -> Maybe String
 unpackConsName (PCons cons _) = Just cons
 unpackConsName _ = Nothing

src/Sapl/SaplTokenizer.dcl

@@ -10,7 +10,7 @@ import StdString, Text.Unicode
 	     | TComment String 
 	     | TInlineAnnotation	     
 	     | TAssignmentOp
-	     | TSelectAssignmentOp
+	     | TCaseAssignmentOp
 	     | TMacroAssignmentOp
 	     | TCAFAssignmentOp	     
      	 | TLambda
@@ -22,8 +22,8 @@ import StdString, Text.Unicode
  		 | TCloseBracket
  		 | TTypeDef
 		 | TLit Literal
-		 | TSelectKeyword
-		 | TIfKeyword
+		 | TCaseKeyword
+		 | TSelectKeyword		 
 		 | TLetKeyword
 		 | TInKeyword
 		 | TEndOfLine

src/Sapl/SaplTokenizer.icl

@@ -101,7 +101,7 @@ read_token base line
 	| matchAt ":==" line start
 		= rnoarg TMacroAssignmentOp 3
 	| matchAt "->" line start
-		= rnoarg TSelectAssignmentOp 2		
+		= rnoarg TCaseAssignmentOp 2		
 	| matchCharAt '\\' line start 
 		= rnoarg TLambda 1
 	| matchCharAt ',' line start 
@@ -136,8 +136,8 @@ read_token base line
 			"false"  = return (TLit (LBool False), stop)
 			"True"   = return (TLit (LBool True), stop)
 			"true"   = return (TLit (LBool True), stop)
+			"case"   = return (TCaseKeyword, stop)
 			"select" = return (TSelectKeyword, stop)
-			"if"     = return (TIfKeyword, stop)
 			"let"	 = return (TLetKeyword, stop)
 			"in"	 = return (TInKeyword, stop)
 			str		 = if (str.[0] == '!') 
@@ -225,8 +225,8 @@ where
 	toString TCloseBracket = "}"
 	toString TTypeDef = "::"
 	toString (TLit lit) = toString lit
+	toString TCaseKeyword = "case"
 	toString TSelectKeyword = "select"
-	toString TIfKeyword = "if"
 	toString TLetKeyword = "let"
 	toString TInKeyword = "in"
 	toString TEndOfLine = "\n"

src/Sapl/Target/JS/CodeGeneratorJS.icl

@@ -14,12 +14,14 @@ import qualified Data.Map as DM
 import Text.Unicode.Encodings.JS
 import Sapl.SaplTokenizer, Sapl.SaplParser, Sapl.Target.Flavour, Sapl.Optimization.StrictnessPropagation
 import Sapl.Transform.Let
+import Sapl.Target.JS.Lifting
 import Sapl.Transform.AddSelectors
 
 from Data.List import elem_by, partition
 
 :: CoderState = { cs_inbody 		:: !Maybe SaplTypedVar     // The body of the function which is being generated (not signature)
 				, cs_intrfunc		:: !Maybe SaplTypedVar     // The name of the currently generated function if it is tail recursive
+				, cs_inletbind		:: !Maybe SaplTypedVar     // The name of the let binding we are in
 				, cs_futuredefs		:: ![SaplTypedVar]     	   // for finding out about let-rec and let bindings defined later 
 				, cs_incaseexpr		:: !Bool
 				, cs_current_vars 	:: ![SaplTypedVar]		 		
@@ -36,6 +38,7 @@ newState :: !Flavour !Bool !ParserState -> CoderState
 newState f tramp p =
 			 { cs_inbody 		= Nothing
 			 , cs_intrfunc 		= Nothing
+			 , cs_inletbind		= Nothing
 			 , cs_futuredefs	= []
 			 , cs_incaseexpr 	= False
 			 , cs_current_vars 	= []
@@ -48,13 +51,6 @@ newState f tramp p =
 			 , cs_prefix        = f.fun_prefix
 			 }
 
-// Returns True if a term can be inlined, i.e. no separate statement is needed
-inline :: !SaplTerm -> Bool
-inline (SLet _ _) = False
-inline (SSelect _ _) = False
-inline (SIf _ _ _) = False
-inline _ = True
-
 pushArgs :: !CoderState ![SaplTypedVar] -> CoderState
 pushArgs s [t:ts] = pushArgs {s & cs_current_vars = [t:s.cs_current_vars]} ts
 pushArgs s [] = s
@@ -99,6 +95,8 @@ callWrapper :: !SaplTerm !CoderState !StringAppender -> StringAppender
 callWrapper t s a
 	| not (inline t)
 		= termCoder t s a		
+	| isJust s.cs_inletbind
+		= a <++ "var " <++ termCoder (fromJust s.cs_inletbind) {s & cs_futuredefs = []} <++ "=" <++ forceTermCoder t s <++ ";"
 	| isJust s.cs_intrfunc && isTailRecursive (fromJust s.cs_intrfunc) t
 		= forceTermCoder t s a
 	| s.cs_trampoline
@@ -106,9 +104,8 @@ callWrapper t s a
 		= a <++ "return " <++ forceTermCoder t s <++ ";" 
 
 isTailRecursive :: !SaplTypedVar !SaplTerm -> Bool
-isTailRecursive var (SSelect _ patterns) = any (isTailRecursive var o snd) patterns
-isTailRecursive var (SIf pred lhs rhs) = isTailRecursive var lhs || isTailRecursive var rhs
-isTailRecursive var (SApplication avar _) = unpackVar var == unpackVar avar
+isTailRecursive var (SCase _ patterns) = any (isTailRecursive var o snd) patterns
+isTailRecursive var (SApplication (SVar avar) _) = unpackVar var == unpackVar avar
 isTailRecursive var (SLet body _) = isTailRecursive var body
 isTailRecursive _ _ = False
 
@@ -305,8 +302,7 @@ splitDefaultPattern patterns
 
 containsUnsafeSelect :: !CoderState !SaplTerm -> Bool
 containsUnsafeSelect s (SApplication _ ts) = any (containsUnsafeSelect s) ts
-containsUnsafeSelect s (SIf _ tb fb) = containsUnsafeSelect s tb || containsUnsafeSelect s fb
-containsUnsafeSelect s (SSelect _ ps) = isUnsafeSelect s ps || any (containsUnsafeSelect s) (map snd ps)
+containsUnsafeSelect s (SCase _ ps) = isUnsafeSelect s ps || any (containsUnsafeSelect s) (map snd ps)
 containsUnsafeSelect s (SLet b _) = containsUnsafeSelect s b
 containsUnsafeSelect s _ = False
 
@@ -455,26 +451,38 @@ where
  * A let definition is not the spine of the function, avoid tail recursion optimization:
  * {s & cs_intrfunc = Nothing}
  */
-letDefCoder :: ![SaplLetDef] !CoderState !StringAppender -> StringAppender
-letDefCoder [t] s a = termCoder t {s & cs_intrfunc = Nothing, cs_futuredefs=[toNormalVar (unpackBindVar t)]} a
-letDefCoder all=:[t:ts] s a
-	= a <++ termCoder t {s & cs_intrfunc = Nothing, cs_futuredefs=fvs} <++ "," 
-		<++ letDefCoder ts {s & cs_current_vars=[unpackBindVar t: s.cs_current_vars]}
+letDefCoder :: ![SaplLetDef] !Bool !CoderState !StringAppender -> StringAppender
+letDefCoder [t] needsvar s a | inline (unpackBindExpr t) 
+		= a <++ if needsvar "var " "," <++ termCoder t {s & cs_intrfunc = Nothing, cs_futuredefs=[toNormalVar (unpackBindVar t)]} <++ ";\n "
+		= a <++ if needsvar "" ";\n" <++ termCoder t {s & cs_intrfunc = Nothing, cs_futuredefs=[toNormalVar (unpackBindVar t)]} <++ ";\n "
+		
+letDefCoder all=:[t:ts] needsvar s a | inline (unpackBindExpr t) 
+	= a <++ if needsvar "var " "," <++ termCoder t {s & cs_intrfunc = Nothing, cs_futuredefs=fvs} 
+		<++ letDefCoder ts False {s & cs_current_vars=[unpackBindVar t: s.cs_current_vars]}
+where
+	fvs = map (toNormalVar o unpackBindVar) all
+
+letDefCoder all=:[t:ts] needsvar s a
+	= a <++ if needsvar "" ";\n" <++ termCoder t {s & cs_intrfunc = Nothing, cs_futuredefs=fvs} <++ ";\n"
+		<++ letDefCoder ts True {s & cs_current_vars=[unpackBindVar t: s.cs_current_vars]}
 where
 	fvs = map (toNormalVar o unpackBindVar) all
 
-letDefCoder [] _ a = a
+letDefCoder [] _ _ a = a
 
 isDependent :: ![SaplVar] !SaplTerm -> Bool 
-isDependent vs (SApplication f as) = any (isDependent vs) [SVar f:as]
+isDependent vs (SApplication (SVar f) as) = any (isDependent vs) [SVar f:as]
 isDependent vs (SVar v) = elem_by eqVarByNameLevel v vs
 isDependent _ _ = False
 
 instance TermCoder SaplLetDef
 where
-	termCoder (SaplLetDef name body) s a
+	termCoder (SaplLetDef name body) s a | inline body
 		= a <++ termCoder name {s & cs_futuredefs = []} <++ "=" 
 			<++ (if (isStrictVar name) forceTermCoder termCoder) body s
+
+	termCoder (SaplLetDef name body) s a
+		= a <++ (if (isStrictVar name) forceTermCoder termCoder) body {s & cs_inletbind = Just name}
 			
 	forceTermCoder t s a = termCoder t s a
 	trampolineCoder t s a = termCoder t s a
@@ -488,7 +496,7 @@ where
 	forceTermCoder :: !SaplTerm !CoderState !StringAppender -> StringAppender
 	forceTermCoder t=:(SVar var) s a = forceTermCoder var s a
 	
-	forceTermCoder t=:(SApplication name args) s a
+	forceTermCoder t=:(SApplication (SVar name) args) s a
 		| isJust mbConstructor && constructor.nr_args == length args
 			= constructorInliner name constructor args s a
 
@@ -504,7 +512,7 @@ where
 				
 		// more arguments than needed: split it
 		| isJust mbFunction && functionArity < length args
-			= forceApp (\a -> a <++ forceTermCoder (SApplication name (take functionArity args)) s <++ ",[" 
+			= forceApp (\a -> a <++ forceTermCoder (SApplication (SVar name) (take functionArity args)) s <++ ",[" 
 							 <++ termArrayCoder (drop functionArity args) "," {s & cs_intrfunc = Nothing} <++ "]") a
 				
 		| isJust mbInlineFun && inlineFun.arity == length args
@@ -561,13 +569,21 @@ where
 				= a <++ escapeName s.cs_prefix (unpackVar fa) <++ "=t" <++ i <++ ";" <++ mta_2 fargs (i+1) s // skip level information for TR!
 			mta_2 [] i s a = a
 
+	forceTermCoder (SApplication sel=:(SSelect _ _) args) s a
+		= a <++ "Sapl.fapp(" <++ forceTermCoder sel s <++ ",["  
+				<++ termArrayCoder args "," s
+				<++ "])"
+
+	forceTermCoder t=:(SSelect expr idx) s a
+      = a <++ "Sapl.feval(" <++ forceTermCoder expr {s & cs_intrfunc = Nothing} <++ "[" <++ idx + 2 <++ "])"
+
 	forceTermCoder t s a = termCoder t s a
 
 	// During trampolining, in only very special cases the expressions are forced in tail call
 	trampolineCoder :: !SaplTerm !CoderState !StringAppender -> StringAppender
 	trampolineCoder t=:(SVar var) s a = trampolineCoder var s a
 		
-	trampolineCoder t=:(SApplication name args) s a
+	trampolineCoder t=:(SApplication (SVar name) args) s a
 		| isJust mbConstructor && constructor.nr_args == length args
 			= constructorInliner name constructor args s a	
 
@@ -588,12 +604,10 @@ where
 	termCoder :: !SaplTerm !CoderState !StringAppender -> StringAppender
 	termCoder t=:(SVar var) s a = termCoder var s a
 		
-	termCoder t=:(SSelector (SSelect expr [(PCons _ vs, SVar x)])) s a
-      # (idx, _) = foldl (\(idx, cnt) v -> if (eqVarByName x v) (cnt, cnt) (idx, cnt + 1)) (0, 0) vs
-      = a <++ "Sapl.feval(" <++ forceTermCoder expr {s & cs_intrfunc = Nothing} <++ "[" <++ idx + 2 <++ "])"
-	termCoder t=:(SSelector x) s a = termCoder x s a
+	termCoder t=:(SSelect expr idx) s a
+      = a <++ "[Sapl.select,[" <++ termCoder expr {s & cs_intrfunc = Nothing} <++ ", " <++ idx + 2 <++ "]]"
 
-	termCoder t=:(SSelect expr patterns) s a | any (isConsPattern o fst) patterns
+	termCoder t=:(SCase expr patterns) s a | any (isConsPattern o fst) patterns
 		# a = a <++ "var ys=" <++ forceTermCoder expr {s & cs_intrfunc = Nothing} <++  ";"
 		= if (containsUnsafeSelect s t) (unsafe a) (safe a)
 	where 
@@ -627,8 +641,14 @@ where
 			= case d of
 				(Just d) = a <++ termCoder (defp d False) s <++ ";"
 						 = a
+
+	termCoder t=:(SCase expr [(PLit (LBool True), true_expr),(PLit (LBool False), false_expr)]) s a
+		= termCodeIf expr true_expr false_expr s a
+
+	termCoder t=:(SCase expr [(PLit (LBool False), false_expr),(PLit (LBool True), true_expr)]) s a
+		= termCodeIf expr true_expr false_expr s a