add capability to parse typed SAPL

src/Sapl/Linker/SaplLinkerShared.icl

@@ -78,7 +78,7 @@ read_line (lmap, startfn, id) line
 				= (lmap, startfn, id+1)
 									
 			(TIdentifier name)
-				# lmap = case skip_arguments next of
+				# lmap = case skip_to_definition next of
 					[TAssignmentOp, (TIdentifier "StdMisc.undef"):_] // skip functions which are undefined
 						= lmap				
 					[TAssignmentOp: ts]
@@ -92,9 +92,10 @@ read_line (lmap, startfn, id) line
 									   
 			_	= (lmap, startfn, id+1) // skip line. e.g. comment
 where 
-	skip_arguments [TIdentifier _:ts] = skip_arguments ts
-	skip_arguments [TStrictIdentifier _:ts] = skip_arguments ts
-	skip_arguments ts = ts
+	skip_to_definition [TIdentifier _:ts] = skip_to_definition ts
+	skip_to_definition [TStrictIdentifier _:ts] = skip_to_definition ts
+	skip_to_definition [TTypeDef:ts] = skip_to_definition ts
+	skip_to_definition ts = ts
 	
 	macroBody ts = toString (macroBody_ (filter macroTokens ts) newAppender)
 	where

src/Sapl/Optimization/StrictnessPropagation.icl

@@ -37,8 +37,8 @@ where
 	(ds, nbody) = (propBody ps flavour newSet body)
 	nargs = map addStrictness args
 	
-	addStrictness var=:(StrictVar _ _) = var
-	addStrictness var=:(NormalVar vn _) = if (member vn ds) (toStrictVar var) var	
+	addStrictness var=:(TypedVar (StrictVar _ _) _) = var
+	addStrictness var=:(TypedVar (NormalVar vn _) _) = if (member vn ds) (toStrictVar var) var	
 
 propFunc ps _ f = (f, ps)
 
@@ -90,8 +90,8 @@ where
 			vn = unpackVar (unpackBindVar bnd)
 
 			// Delete itself, it dosn't need any more
-			walkbnd sd (SaplLetDef (StrictVar vn _) body) = delete vn (fst (walk sd body)) // skip new body, it cannot be a let definition
-			walkbnd sd (SaplLetDef (NormalVar vn _) body) = delete vn sd
+			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
 		
 	walk sd t = (sd, t)
 			

src/Sapl/SaplParser.dcl

@@ -7,7 +7,7 @@ from Data.Map import :: Map
 // Cannot be abstract because code generator uses it
 :: ParserState = { ps_level 		:: Int
 				 , ps_constructors  :: Map String ConstructorDef
-				 , ps_functions		:: Map String [SaplVar]
+				 , ps_functions		:: Map String [SaplTypedVar]
 				 , ps_CAFs			:: Map String Void
 				 , ps_genFuns		:: [FuncType] 			// generated functions during parsing				 
 		      	 }
@@ -15,7 +15,7 @@ from Data.Map import :: Map
 :: ConstructorDef = { index		:: !Int
 					, nr_cons   :: !Int
 					, nr_args	:: !Int			// for efficiency
-					, args		:: [SaplVar]
+					, args		:: [SaplTypedVar]
 					}
 
 :: ErrorMsg :== String

src/Sapl/SaplParser.icl

@@ -58,8 +58,8 @@ where
 	genadt nrargs s = FTADT (NormalVar name 0) [SaplConstructor (NormalVar name 0) 0 [genarg i s \\ i <- [1..nrargs]]]
 	
 	genarg i s | s bitand (1 << (i-1)) > 0
-		= StrictVar "_" 0
-		= NormalVar "_" 0		
+		= TypedVar (StrictVar "_" 0) NoType
+		= TypedVar (NormalVar "_" 0) NoType	
 
 addTupleCons _ = returnS Void
 
@@ -116,14 +116,22 @@ mainexpr ts = selectexpr ts
 
 letdefinitions ts = letdef_1 ts []
 where
+	letdef_1 [TIdentifier name, TTypeDef, TIdentifier type, TAssignmentOp:ts] as = 
+				getLevel
+			>>= \level = application 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 
-			>>= \(t, ts) = letdef_2 ts [SaplLetDef (NormalVar name level) t:as]
+			>>= \(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 
+			>>= \(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 
-			>>= \(t, ts) = letdef_2 ts [SaplLetDef (StrictVar name level) t:as]
+			>>= \(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)
@@ -195,14 +203,18 @@ where
 
 args_annotated ts = args_ ts []
 where
-	args_ [TIdentifier name:ts] as = getLevel >>= \level = args_ ts [NormalVar name level:as] 
-	args_ [TStrictIdentifier name:ts] as = args_ ts [StrictVar name 0:as]
+	args_ [TIdentifier name,TTypeDef,TIdentifier type:ts] as = getLevel >>= \level = args_ ts [TypedVar (NormalVar name level) (Type type):as]
+	args_ [TIdentifier name:ts] as = getLevel >>= \level = args_ ts [TypedVar (NormalVar name level) NoType:as] 
+	args_ [TStrictIdentifier name,TTypeDef,TIdentifier type:ts] as = args_ ts [TypedVar (StrictVar name 0) (Type type):as]
+	args_ [TStrictIdentifier name:ts] as = args_ ts [TypedVar (StrictVar name 0) NoType:as]
 	args_ ts as = returnS (reverse as, ts)
 
 args_record ts = args_1 ts []
 where
-	args_1 [TIdentifier name:ts] as = getLevel >>= \level = args_2 ts [NormalVar name level:as]
-	args_1 [TStrictIdentifier name:ts] as = getLevel >>= \level = args_2 ts [StrictVar name level:as]		
+	args_1 [TIdentifier name,TTypeDef,TIdentifier type:ts] as = getLevel >>= \level = args_2 ts [TypedVar (NormalVar name level) (Type type):as]
+	args_1 [TIdentifier name:ts] as = getLevel >>= \level = args_2 ts [TypedVar (NormalVar name level) NoType:as]
+	args_1 [TStrictIdentifier name,TTypeDef,TIdentifier type:ts] as = getLevel >>= \level = args_2 ts [TypedVar (StrictVar name level) (Type type):as]	
+	args_1 [TStrictIdentifier name:ts] as = getLevel >>= \level = args_2 ts [TypedVar (StrictVar name level) NoType:as]	
 	args_1 ts as = returnE (ts, "Missing argument")
 	args_2 [TColon:ts] as = args_1 ts as
 	args_2 ts as = returnS (reverse as, ts)
@@ -236,12 +248,20 @@ constr [TTypeDef, TIdentifier name, TAssignmentOp: ts] =
 constr [TTypeDef:ts] = returnE (ts, "Invalid type definition")
 constr ts = returnE (ts, "Not a type definition")
 
-func [TIdentifier name, TCAFAssignmentOp:ts] = 
+func [TIdentifier name, TTypeDef, TIdentifier type, TCAFAssignmentOp:ts] = typed_caf name (Type type) ts			
+func [TIdentifier name, TCAFAssignmentOp:ts] = typed_caf name NoType ts
+func [TIdentifier name, TTypeDef, TIdentifier type:ts] = typed_fun name (Type type) ts			
+func [TIdentifier name:ts] = typed_fun name NoType ts
+
+func ts=:[TTypeDef:_] = constr ts >>= \(f,ts) = returnS (f, ts)
+func ts = returnE (ts, "Not a function or type definition")
+
+typed_caf name type ts =
 				getLevel
 			>>= \level = body ts
-			>>= \(t, ts) = addCAF (NormalVar name level) >>= \tname = returnS (FTCAF tname t, ts)
-			
-func [TIdentifier name:ts] = 
+			>>= \(t, ts) = addCAF (NormalVar name level) >>= \tname = returnS (FTCAF (TypedVar tname type) t, ts)
+
+typed_fun name type ts =
 				getLevel
 			>>= \level = args_annotated ts 
 			>>= \(as, ts) = case hd ts of
@@ -250,11 +270,8 @@ func [TIdentifier name:ts] =
 									   = returnE (ts, "Missing assignment operator")
 			>>= \(func, ts) = body ts 
 			>>= \(t, ts) = if func 
-							(addFunction (NormalVar name level) as >>= \tname = returnS (FTFunc tname t as, ts))
-							(addFunction (NormalVar name level) as >>= \tname = returnS (FTMacro tname t as, ts))
-
-func ts=:[TTypeDef:_] = constr ts >>= \(f,ts) = returnS (f, ts)
-func ts = returnE (ts, "Not a function or type definition")
+							(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))
 
 skip_newlines [TEndOfLine:ts] = skip_newlines ts
 skip_newlines ts = returnS ts

src/Sapl/SaplStruct.dcl

@@ -7,13 +7,13 @@ import Data.Maybe
 /**
 * Possible function types and language constructs.
 */
-:: FuncType = FTRecord SaplVar [SaplVar]
+:: FuncType = FTRecord SaplVar [SaplTypedVar]
 			| FTADT SaplVar [SaplConstructor]
-			| FTCAF SaplVar SaplTerm
-			| FTMacro SaplVar SaplTerm [SaplVar]
-			| FTFunc SaplVar SaplTerm [SaplVar]
+			| FTCAF SaplTypedVar SaplTerm
+			| FTMacro SaplTypedVar SaplTerm [SaplTypedVar]
+			| FTFunc SaplTypedVar SaplTerm [SaplTypedVar]
 
-:: SaplConstructor 	= SaplConstructor SaplVar Int [SaplVar]
+:: SaplConstructor 	= SaplConstructor SaplVar Int [SaplTypedVar]
 
 :: SaplTerm = SLit Literal
 			| SVar SaplVar
@@ -24,15 +24,21 @@ import Data.Maybe
 			| SLet SaplTerm [SaplLetDef]
 			| SAbortBody			
 
-:: SaplLetDef = SaplLetDef SaplVar SaplTerm
+:: SaplLetDef = SaplLetDef SaplTypedVar SaplTerm
 
-:: SaplVar = NormalVar String Int 
-		   | StrictVar String Int
+:: SaplName :== String
+
+:: SaplVar = NormalVar SaplName Int 
+		   | StrictVar SaplName Int
+
+:: SaplTypedVar = TypedVar SaplVar SaplType
 
 :: SaplPattern = PCons String [SaplVar]
 			   | PLit Literal
 			   | PDefault
 
+:: SaplType = Type String | NoType
+
 instance toString SaplVar
 
 // I don't provide instances of (==) and (<) here because multiple good way can be imagined...
@@ -41,13 +47,26 @@ ltVarByName :: !SaplVar !SaplVar -> Bool
 eqVarByNameLevel :: !SaplVar !SaplVar -> Bool
 ltVarByNameLevel :: !SaplVar !SaplVar -> Bool
 
-eqStrictVar :: !String !SaplVar -> Bool
-isStrictVar :: !SaplVar -> Bool
-toNormalVar :: !SaplVar -> SaplVar
-toStrictVar :: !SaplVar -> SaplVar
+removeTypeInfo :: !SaplTypedVar -> SaplVar
+
+class eqStrictVar v :: !String !v -> Bool
+class isStrictVar v :: !v -> Bool
+class toNormalVar v :: !v -> v
+class toStrictVar v :: !v -> v
+class unpackVar v :: !v -> String
+
+instance eqStrictVar SaplVar
+instance eqStrictVar SaplTypedVar
+instance isStrictVar SaplVar
+instance isStrictVar SaplTypedVar
+instance toNormalVar SaplVar
+instance toNormalVar SaplTypedVar
+instance toStrictVar SaplVar
+instance toStrictVar SaplTypedVar
+instance unpackVar SaplVar
+instance unpackVar SaplTypedVar
 
-unpackVar      :: !SaplVar -> String
-unpackBindVar  :: !SaplLetDef -> SaplVar
+unpackBindVar  :: !SaplLetDef -> SaplTypedVar
 unpackConsName :: !SaplPattern -> Maybe String
 toStrictBind   :: !SaplLetDef -> SaplLetDef
 

src/Sapl/SaplStruct.icl

@@ -25,35 +25,73 @@ where
 	toString (StrictVar name 0) = "!" +++ name
 	toString (StrictVar name level) = "!" +++ name +++ "_" +++ toString level
 
-isStrictVar :: !SaplVar -> Bool
-isStrictVar (StrictVar _ _) = True
-isStrictVar _ = False
+removeTypeInfo :: !SaplTypedVar -> SaplVar
+removeTypeInfo (TypedVar var _) = var
 
-eqStrictVar :: !String !SaplVar -> Bool
-eqStrictVar name1 (StrictVar name2 _) = name1 == name2 
-eqStrictVar _ _ = False
+instance eqStrictVar SaplVar
+where
+	eqStrictVar :: !String !SaplVar -> Bool
+	eqStrictVar name1 (StrictVar name2 _) = name1 == name2 
+	eqStrictVar _ _ = False
+
+instance eqStrictVar SaplTypedVar
+where
+	eqStrictVar :: !String !SaplTypedVar -> Bool
+	eqStrictVar name (TypedVar var _) = eqStrictVar name var
+
+instance isStrictVar SaplVar
+where
+	isStrictVar :: !SaplVar -> Bool
+	isStrictVar (StrictVar _ _) = True
+	isStrictVar _ = False
+
+instance isStrictVar SaplTypedVar
+where
+	isStrictVar :: !SaplTypedVar -> Bool
+	isStrictVar (TypedVar var _) = isStrictVar var
+
+instance toNormalVar SaplVar
+where
+	toNormalVar :: !SaplVar -> SaplVar
+	toNormalVar (StrictVar name level) = (NormalVar name level)
+	toNormalVar v = v
+
+instance toNormalVar SaplTypedVar
+where
+	toNormalVar :: !SaplTypedVar -> SaplTypedVar
+	toNormalVar (TypedVar var type) = TypedVar (toNormalVar var) type
+
+instance toStrictVar SaplVar
+where
+	toStrictVar :: !SaplVar -> SaplVar
+	toStrictVar (NormalVar name level) = (StrictVar name level)
+	toStrictVar v = v
 
-toNormalVar :: !SaplVar -> SaplVar
-toNormalVar (StrictVar name level) = (NormalVar name level)
-toNormalVar v = v
+instance toStrictVar SaplTypedVar
+where
+	toStrictVar :: !SaplTypedVar -> SaplTypedVar
+	toStrictVar (TypedVar var type) = TypedVar (toStrictVar var) type
 
-toStrictVar :: !SaplVar -> SaplVar
-toStrictVar (NormalVar name level) = (StrictVar name level)
-toStrictVar v = v
+instance unpackVar SaplVar
+where
+	unpackVar :: !SaplVar -> String
+	unpackVar (NormalVar name _) = name
+	unpackVar (StrictVar name _) = name
 
-unpackVar :: !SaplVar -> String
-unpackVar (NormalVar name _) = name
-unpackVar (StrictVar name _) = name
+instance unpackVar SaplTypedVar
+where
+	unpackVar :: !SaplTypedVar -> String
+	unpackVar (TypedVar var _) = unpackVar var
 
-unpackBindVar :: !SaplLetDef -> SaplVar
-unpackBindVar (SaplLetDef var _) = var
+unpackBindVar :: !SaplLetDef -> SaplTypedVar
+unpackBindVar (SaplLetDef typedVar _) = typedVar
 
 unpackConsName :: !SaplPattern -> Maybe String
 unpackConsName (PCons cons _) = Just cons
 unpackConsName _ = Nothing
 
 toStrictBind :: !SaplLetDef -> SaplLetDef
-toStrictBind (SaplLetDef var body) = SaplLetDef (toStrictVar var) body
+toStrictBind (SaplLetDef (TypedVar var type) body) = SaplLetDef (TypedVar (toStrictVar var) type) body
 
 isConsPattern :: !SaplPattern -> Bool
 isConsPattern (PCons _ _) = True

src/Sapl/Target/JS/CodeGeneratorJS.icl

@@ -18,13 +18,13 @@ import Sapl.Transform.AddSelectors
 
 from Data.List import elem_by, partition
 
-:: CoderState = { cs_inbody 		:: !Maybe SaplVar     // The body of the function which is being generated (not signature)
-				, cs_intrfunc		:: !Maybe SaplVar     // The name of the currently generated function if it is tail recursive
-				, cs_futuredefs		:: ![SaplVar]     	  // for finding out about let-rec and let bindings defined later 
+:: 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_futuredefs		:: ![SaplTypedVar]     	   // for finding out about let-rec and let bindings defined later 
 				, cs_incaseexpr		:: !Bool
-				, cs_current_vars 	:: ![SaplVar]		 // Strict, Normal
+				, cs_current_vars 	:: ![SaplTypedVar]		 		
 				, cs_constructors	:: !Map String ConstructorDef
-				, cs_functions		:: !Map String [SaplVar]
+				, cs_functions		:: !Map String [SaplTypedVar]
 				, cs_CAFs			:: !Map String Void				
 				, cs_builtins		:: !Map String (String, Int)
 				, cs_inlinefuncs	:: !Map String InlineFunDef
@@ -55,7 +55,7 @@ inline (SSelect _ _) = False
 inline (SIf _ _ _) = False
 inline _ = True
 
-pushArgs :: !CoderState ![SaplVar] -> CoderState
+pushArgs :: !CoderState ![SaplTypedVar] -> CoderState
 pushArgs s [t:ts] = pushArgs {s & cs_current_vars = [t:s.cs_current_vars]} ts
 pushArgs s [] = s
 
@@ -105,7 +105,7 @@ callWrapper t s a
 		= a <++ "return " <++ trampolineCoder t s <++ ";" 	
 		= a <++ "return " <++ forceTermCoder t s <++ ";" 
 
-isTailRecursive :: !SaplVar !SaplTerm -> Bool
+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
@@ -122,7 +122,7 @@ funcCoder (FTRecord name args) s a
 	= a <++ termCoder name s <++ ".$f=[" <++ recordFieldCoder args <++ "];"
 
 // Only real constants can be safely encoded as a simple variable...
-encodeCAF :: !SaplVar !SaplTerm !CoderState !StringAppender -> StringAppender
+encodeCAF :: !SaplTypedVar !SaplTerm !CoderState !StringAppender -> StringAppender
 encodeCAF name body=:(SLit _) s a
 	# a = a <++ "var " <++ termCoder name s <++ " = "
 
@@ -148,7 +148,7 @@ encodeCAF name body s a
 
 	= a <++ "},[]];";
 
-normalFunc :: !SaplVar !SaplTerm ![SaplVar] !CoderState !StringAppender -> StringAppender
+normalFunc :: !SaplTypedVar !SaplTerm ![SaplTypedVar] !CoderState !StringAppender -> StringAppender
 normalFunc name body args s a
 	// Generate $eval function if any of its arguments is annotated as strict	
 	# a = if (any isStrictVar args) 
@@ -157,7 +157,7 @@ normalFunc name body args s a
 	// Generate function signature			
 	# a = a <++ "function " <++ termCoder name s
 			<++ "(" <++ termArrayCoder args "," s <++ "){"
-
+	
 	// Update coder state with the new local arguments, ...
 	# s = {s & cs_inbody = Just name
 			 , cs_current_vars = args
@@ -191,7 +191,7 @@ make_app_args func args s a
 					   = a <++ maa_ [] args 0 s 
 where
 	// fargs: formal, aargs: actual	
-	maa_ [(StrictVar _ _):fargs] [aa:aargs] i s a 
+	maa_ [TypedVar (StrictVar _ _) _:fargs] [aa:aargs] i s a 
 		# a = if (i>0) (a <++ ",") a
 		= a <++ forceTermCoder aa s <++ maa_ fargs aargs (i+1) s 
 	maa_ [_:fargs] [aa:aargs] i s a 
@@ -202,9 +202,9 @@ where
 		= a <++ termCoder aa s <++ maa_ [] aargs (i+1) s 
 	maa_ _ [] _ _ a = a
 
-recordFieldCoder :: ![SaplVar] !StringAppender -> StringAppender
-recordFieldCoder [t] a = a <++ "\"" <++ unpackVar t <++ "\""
-recordFieldCoder [t:ts] a
+recordFieldCoder :: ![SaplTypedVar] !StringAppender -> StringAppender
+recordFieldCoder [TypedVar t _] a = a <++ "\"" <++ unpackVar t <++ "\""
+recordFieldCoder [TypedVar t _:ts] a
 	= a <++ "\"" <++ unpackVar t <++ "\"," <++ recordFieldCoder ts
 recordFieldCoder [] a = a
 
@@ -226,7 +226,7 @@ where
 //----------------------------------------------------------------------------------------
 // Data constructor...
 
-constructorCoder :: !SaplVar !Int ![SaplVar] CoderState !StringAppender -> StringAppender
+constructorCoder :: !SaplVar !Int ![SaplTypedVar] CoderState !StringAppender -> StringAppender
 
 // A zero argument data constructor is a CAF
 constructorCoder name id [] s a
@@ -261,11 +261,11 @@ constructorInliner name def args s a
 	= a	<++ "]"
 where
 	// Formal arguments, actual arguments
-	argsCoder [NormalVar _ _] [t] sep s a = termCoder t s a
-	argsCoder [StrictVar _ _] [t] sep s a = forceTermCoder t s a	
-	argsCoder [NormalVar _ _:fs] [t:ts] sep s a 
+	argsCoder [TypedVar (NormalVar _ _) _] [t] sep s a = termCoder t s a
+	argsCoder [TypedVar (StrictVar _ _) _] [t] sep s a = forceTermCoder t s a	
+	argsCoder [TypedVar (NormalVar _ _) _:fs] [t:ts] sep s a 
 			= a <++ termCoder t s <++ sep <++ argsCoder fs ts sep s
-	argsCoder [StrictVar _ _:fs] [t:ts] sep s a 
+	argsCoder [TypedVar (StrictVar _ _) _:fs] [t:ts] sep s a 
 			= a <++ forceTermCoder t s <++ sep <++ argsCoder fs ts sep s	
 	argsCoder [] [] _ s a = a
 
@@ -352,8 +352,8 @@ where
 
 		get_cons   = get_cons_or_die s cons
 
-		annotate (StrictVar _ _, arg) = toStrictVar arg
-		annotate (_, arg) = arg
+		annotate (TypedVar (StrictVar _ _) type, arg) = TypedVar (toStrictVar arg) type
+		annotate (TypedVar _ type, arg) = TypedVar arg type
 
 	forceTermCoder t s a = termCoder t s a
 	trampolineCoder t s a = termCoder t s a
@@ -361,6 +361,12 @@ where
 //----------------------------------------------------------------------------------------
 // Variables...
 
+instance TermCoder SaplTypedVar
+where
+	forceTermCoder var s a = forceTermCoder (removeTypeInfo var) s a
+	trampolineCoder var s a = trampolineCoder (removeTypeInfo var) s a
+	termCoder var s a = termCoder (removeTypeInfo var) s a
+
 instance TermCoder SaplVar
 where
 	forceTermCoder t=:(NormalVar name level) s a
@@ -410,7 +416,7 @@ where
 			= a <++ escapeName s.cs_prefix name <++ "$eval"	
 
 			// else (TODO: probably bogus in tail-recursion...)
-			| any (eqVarByNameLevel t) s.cs_futuredefs
+			| any (eqVarByNameLevel t) (map removeTypeInfo s.cs_futuredefs)
 				= a <++ "[function(){return " <++ force var_name <++ ";},[]]"
 
 			// else: use the defined name if its a built-in function, otherwise its a variable...
@@ -424,10 +430,10 @@ where
 		mbCAF = 'DM'.get name s.cs_CAFs
 
 		// TODO: doc
-		findLocalVar [(NormalVar cn level):cs] = if (cn == name) level (findLocalVar cs)
-		findLocalVar [(StrictVar cn level):cs] = if (cn == name) level (findLocalVar cs)
+		findLocalVar [TypedVar (NormalVar cn level) _:cs] = if (cn == name) level (findLocalVar cs)
+		findLocalVar [TypedVar (StrictVar cn level) _:cs] = if (cn == name) level (findLocalVar cs)
 		findLocalVar [] = 0
-		isLocalVar = elem_by eqVarByName t s.cs_current_vars //isMember t s.cs_current_vars
+		isLocalVar = elem_by eqVarByName t (map removeTypeInfo s.cs_current_vars) //isMember t s.cs_current_vars
 		
 		isFunction = isJust ('DM'.get t s.cs_functions)		
 		isStrictFunction = a || b
@@ -543,7 +549,7 @@ where
 			= a <++ "var " <++ mta_1 tr_function_args args 0 s <++ ";" 
 				<++ mta_2 tr_function_args 0 s <++ "continue;"
 		where
-			mta_1 [(StrictVar _ _):fargs] [aa:aargs] i s a 
+			mta_1 [TypedVar (StrictVar _ _) _:fargs] [aa:aargs] i s a 
 				# a = if (i>0) (a <++ ",") a
 				= a <++ "t" <++ i <++ "=" <++ forceTermCoder aa s <++ mta_1 fargs aargs (i+1) s 
 			mta_1 [_:fargs] [aa:aargs] i s a 
@@ -701,7 +707,7 @@ exprGenerateJS f tramp saplsrc mbPst out
 	= case parseExpr pts of
 		Ok (body, s) # newpst = mergeParserStates s mbPst
 					 # state = newState f tramp newpst
-					 # a = termCoder body {state & cs_inbody=Just (NormalVar "__dummy" 0)} newAppender
+					 # a = termCoder body {state & cs_inbody=Just (TypedVar (NormalVar "__dummy" 0) NoType)} newAppender
 					 # out = foldl (\a curr = a <++ funcCoder curr state) out s.ps_genFuns
 					 = Ok (toString a, out, newpst)
 		Error msg = Error msg

src/Sapl/Transform/Let.icl

@@ -17,7 +17,7 @@ where
 
 // Generate the graph: edges and the start nodes (independent nodes)
 genGraph :: !(Set SaplVar) ![SaplLetDef] -> (!Set (SaplVar,SaplVar), !Set SaplVar)
-genGraph binds defs = foldl (\s (SaplLetDef bv body) -> gen binds bv s body) ('Data.Set'.newSet,binds) defs
+genGraph binds defs = foldl (\s (SaplLetDef (TypedVar bv _) body) -> gen binds bv s body) ('Data.Set'.newSet,binds) defs
 where
 	gen vs bv s (SApplication f as) = foldl (gen vs bv) s [SVar f:as]
 	gen vs bv (es,is) (SVar v) 
@@ -34,8 +34,8 @@ sortBindings defs
 		= Nothing // cycle is detected
 where
 	(edges, startnodes) = genGraph binds defs 
-	binds  = 'Data.Set'.fromList (map (toNormalVar o unpackBindVar) defs)
-	defmap = 'Data.Map'.fromList (map (\d=:(SaplLetDef bv body) -> (bv,d)) defs)	
+	binds  = 'Data.Set'.fromList (map (removeTypeInfo o toNormalVar o unpackBindVar) defs)
+	defmap = 'Data.Map'.fromList (map (\d=:(SaplLetDef bv body) -> (removeTypeInfo bv,d)) defs)	
 
 	// Returns the renaming edges (if any) and the ordered list of bind vars (reversed order)
 	gen edges [] = (edges, [])