Initial import

git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@2 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d

1 files changed, 200 insertions, 0 deletions

diff --git a/frontend/utilities.icl b/frontend/utilities.icl
new file mode 100644
index 0000000..51e11ce
--- /dev/null
+++ b/frontend/utilities.icl
@@ -0,0 +1,200 @@
+implementation module utilities
+
+import	StdEnv, general
+    
+
+/*
+		Utility routines.
+*/
+StringToCharList`	:: !String !Int !Int -> [Char]
+StringToCharList` string 0 index
+		= 	[]
+StringToCharList` string length index
+		= [string.[index] : StringToCharList` string (dec length) (inc index)]
+		
+stringToCharList	:: !String ->	[Char]
+stringToCharList string = StringToCharList` string (size string) 0
+
+charListToString	:: ![Char] -> String
+charListToString [hd:tl] = toString hd +++ charListToString tl 
+charListToString []      = ""
+
+revCharListToString	:: !Int ![Char] -> String
+revCharListToString max_index l
+	# string = createArray (max_index + 1) '\0'
+	= fill_string max_index l string
+where
+	fill_string :: !Int ![Char] !*String -> *String
+	fill_string n [ char : rest] string
+		= fill_string (n - 1) rest { string & [n] = char }
+	fill_string (-1) [] string
+		= string
+		  
+/*
+revCharListToString [hd:tl] = revCharListToString tl +++ toString hd 
+revCharListToString []      = ""
+*/
+
+isUpperCaseName :: ! String -> Bool
+isUpperCaseName id
+	= ('A' <= c  &&  c <= 'Z') || c == '_' 
+   	  where
+   	  c =: id.[0]
+
+isLowerCaseName :: ! String -> Bool
+isLowerCaseName id
+	= 'a' <= c  &&  c <= 'z' 
+   	  where
+   	  c =: id.[0]
+
+isFunnyIdName :: ! String -> Bool
+isFunnyIdName id
+	= isSpecialChar id.[0]
+
+isSpecialChar	:: !Char -> Bool
+isSpecialChar '~'	= True
+isSpecialChar '@'	= True
+isSpecialChar '#'	= True
+isSpecialChar '$'	= True
+isSpecialChar '%'	= True
+isSpecialChar '^'	= True
+isSpecialChar '?'	= True
+isSpecialChar '!'	= True
+isSpecialChar '+'	= True
+isSpecialChar '-'	= True
+isSpecialChar '*'	= True
+isSpecialChar '<'	= True
+isSpecialChar '>'	= True
+isSpecialChar '\\'	= True
+isSpecialChar '/'	= True
+isSpecialChar '|'	= True
+isSpecialChar '&'	= True
+isSpecialChar '='	= True
+isSpecialChar ':'	= True
+isSpecialChar '.'	= True
+isSpecialChar c	= False
+
+strictMap :: !(.a -> .b) ![.a] -> [.b]
+strictMap f [x : xs]
+		#!	head = f x
+			tail = strictMap f xs
+		=	[head : tail]
+strictMap f xs
+		= []
+
+strictMapAppend :: !(.a -> .b) ![.a] !u:[.b] -> v:[.b], [u <= v]
+strictMapAppend f [x : xs] tail
+	#! x = f x
+	   xs = strictMapAppend f xs tail
+	= [x : xs]
+strictMapAppend f [] tail
+	= tail
+
+mapAppend :: !(.a -> .b) ![.a] !u:[.b] -> u:[.b]
+mapAppend f [x : xs] tail
+	#  x = f x
+	   xs = mapAppend f xs tail
+	= [x : xs]
+mapAppend f [] tail
+	= tail
+
+
+mapAppendSt :: !(.a -> .(.b -> (.c,.b))) ![.a] !u:[.c] !.b -> !(!u:[.c],!.b)
+mapAppendSt f [x : xs] tail s 
+	# (x, s) = f x s
+	  (xs, s) = mapAppendSt f xs tail s
+	= ([x : xs], s)
+mapAppendSt f [] tail s
+	= (tail, s)
+
+mapSt :: !(.a -> (.st -> (.c,.st))) ![.a] !.st -> (![.c],!.st)
+mapSt f [x : xs] s
+ 	# (x, s) = f x s
+	  (xs, s) = mapSt f xs s
+	= ([x : xs], s)
+mapSt f [] s
+ 	= ([], s)
+
+app2St :: !(!.(.a -> .(.st -> (.c,.st))),!.(.e -> .(.st -> (.f,.st)))) !(.a,.e) !.st -> (!(.c,.f),!.st)
+app2St (f,g) (x,y) s
+ 	# (x, s) = f x s
+	  (y, s) = g y s
+	= ((x,y), s)
+
+
+// foldl2 :: !(.c -> .(.a -> .(.b -> .c))) !.c ![.a] ![.b] -> .c
+foldl2 op r l1 l2
+	:== foldl2 r l1 l2
+where
+	foldl2 r [x : xs] [y : ys]
+		= foldl2 (op r x y) xs ys
+	foldl2 r [] []
+		= r
+//foldr2 :: !(.a -> .(.b -> .(.c -> .c))) !.c ![.a] ![.b] -> .c
+
+foldr2 op r l1 l2
+	:== foldr2 r l1 l2
+where
+	foldr2 r [x : xs] [y : ys]
+		= op x y (foldr2 r xs ys)	
+	foldr2 r [] []
+		= r
+
+fold2St op l1 l2 st
+	:== fold_st2 l1 l2 st
+where
+	fold_st2 [x : xs] [y : ys] st
+		= op x y (fold_st2 xs ys st)	
+	fold_st2 [] [] st
+		= st
+	fold_st2 [] ys st
+		= abort ("fold_st2: second argument list contains more elements" ---> ys)
+	fold_st2 xs [] st
+		= abort ("fold_st2: first argument list contains more elements" ---> xs)
+
+// foldSt :: !(.a -> .(.st -> .st)) ![.a] !.st -> .st
+foldSt op r l :== fold_st r l
+	where
+		fold_st [] st		= st
+		fold_st [a:x] st	= fold_st x (op a st)
+
+iFoldSt op fr to st :== i_fold_st fr to st
+	where
+		i_fold_st fr to st
+			| fr >= to
+				= st
+				= i_fold_st (inc fr) to (op fr st)
+
+iterateSt op st :== iterate_st op st
+	where
+		iterate_st op st
+			# (continue, st) = op (False, st)
+			| continue
+				= iterate_st op st
+				= st
+
+eqMerge :: ![a] ![a] -> [a] | Eq a
+eqMerge [a : x] y
+	| isMember a y
+		= eqMerge x y
+		= [a : eqMerge x y]
+eqMerge x y
+		= y
+
+revAppend	:: ![a] ![a] -> [a]	//	Reverse the list using the second argument as accumulator.
+revAppend [] acc = acc
+revAppend [x : xs] acc = revAppend xs [x : acc]
+
+revMap :: !(.a -> .b) ![.a] !u:[.b] -> u:[.b]
+revMap f [] acc = acc
+revMap f [x : xs] acc = revMap f xs [f x : acc]
+
+
+
+/*		
+zip2Append :: [.a] [.b] u:[w:(.a,.b)] -> v:[x:(.a,.b)], [w <= x, u <= v]
+zip2Append [] [] tail
+	= tail
+zip2Append [x : xs] [y : ys] tail
+	= [(x,y) : zip2Append xs ys tail]
+*/