+ new tests

+ new prims
+ increased stack sizes for the tests

interpreter/code.c

@@ -108,7 +108,6 @@ void set_create_thunk_fun(Code* code)
     {
         case CT_APP_PRIM1:
         case CT_APP_PRIM_S:
-        case CT_APP_PRIM_T:
         case CT_APP_PRIM2:
         case CT_APP_PRIM_ST:
         case CT_APP_PRIM_TS:
@@ -174,15 +173,6 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
             destroy_stack_frame_b(root_frame_ptr_b);
             return;                        
         }
-        case CT_APP_PRIM_T:
-        {
-            push_a(&((ThunkEntry*) ((AppEntry*) expr)->args[0])->thunk);                        
-            ((PrimEntry*) ((AppEntry*) expr)->f)->exec(root_frame_ptr);
-
-            destroy_stack_frame(root_frame_ptr);
-            destroy_stack_frame_b(root_frame_ptr_b);
-            return;                        
-        }        
         case CT_APP_PRIM_ST:
         {            
             push_a(local(frame_ptr, ((VarEntry*) ((AppEntry*) expr)->args[0])->index));                        
@@ -488,6 +478,10 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
                         push_a(pattern->_args[i]);
                     }                  
                 }
+                else if(caseEntry->type == SC_DEFAULT)
+                {
+                    // accept it
+                }
                 else if (caseEntry->type == SC_LIT) {
                     printf("Exec: Unhandled entry type in CT_SELECT (SC_LIT)");
                     exit(-1);

interpreter/code.h

@@ -5,7 +5,7 @@
 
 enum CodeType {
     CT_VAR, CT_VAR_STRICT, 
-    CT_APP_PRIM1, CT_APP_PRIM_T, CT_APP_PRIM_S, 
+    CT_APP_PRIM1, CT_APP_PRIM_S, 
     CT_APP_PRIM2, CT_APP_PRIM_ST, CT_APP_PRIM_TS, CT_APP_PRIM_SS, CT_APP_PRIM_TA, CT_APP_PRIM_AT, CT_APP_PRIM_AS, CT_APP_PRIM_SA,
     CT_APP_THUNK, CT_APP_FUN, CT_APP_DYN, 
     CT_SELECT, CT_IF, 

interpreter/main.c

@@ -29,7 +29,7 @@ int main ( int argc, char *argv[] )
     init_desc();
     init_prim();
 
-    char* input = "..\\tests\\Braun.bsapl";
+    char* input = "..\\tests\\Sprimes.bsapl";
     
     if ( argc == 2 )
     {
@@ -57,7 +57,7 @@ int main ( int argc, char *argv[] )
         fclose( file );
         if(len < 0) exit(-1);
     }
-
+    
 #ifdef DEBUG
     printf("sizeof(int): %d, sizeof(long): %d, sizeof(void*): %d, sizeof(Thunk): %d\n\n", 
             sizeof(int), sizeof(long), sizeof(void*), sizeof(Thunk));

interpreter/mem.h

@@ -3,8 +3,8 @@
 
 #include "thunk.h"
 
-#define STACK_SIZE_A 10240
-#define STACK_SIZE_B 10240
+#define STACK_SIZE_A 10240*50
+#define STACK_SIZE_B 10240*50
 
 extern int stack_top_a;
 extern int stack_top_b;

interpreter/parse.c

@@ -363,11 +363,7 @@ Code* parseApp(char **ptr, bool dynamic) {
 
             if(desc->type == FT_PRIM1)
             {
-                if(entry->args[0]->type == CT_THUNK)
-                {
-                    entry->base.type = CT_APP_PRIM_T;
-                }
-                else if(entry->args[0]->type == CT_VAR_STRICT)
+                if(entry->args[0]->type == CT_VAR_STRICT)
                 {
                     entry->base.type = CT_APP_PRIM_S;
                 }
@@ -386,7 +382,7 @@ Code* parseApp(char **ptr, bool dynamic) {
                 {
                     entry->base.type = CT_APP_PRIM_TS;
                 }                
-                else if(entry->args[1]->type == CT_VAR_STRICT && entry->args[0]->type == CT_VAR_STRICT)
+                else if(entry->args[0]->type == CT_VAR_STRICT && entry->args[1]->type == CT_VAR_STRICT)
                 {
                     entry->base.type = CT_APP_PRIM_SS;
                 }                

interpreter/prim.c

@@ -19,6 +19,18 @@ void __sub(int dst_idx) {
     target->_int = readI(arg(2)) - readI(arg(1));
 }
 
+void __mult(int dst_idx) {
+    Thunk* target = get_dst(dst_idx);
+    target->desc = (Desc*) __INT__;
+    target->_int = readI(arg(2)) * readI(arg(1));
+}
+
+void __div(int dst_idx) {
+    Thunk* target = get_dst(dst_idx);
+    target->desc = (Desc*) __INT__;
+    target->_int = readI(arg(2)) / readI(arg(1));
+}
+
 void __gt(int dst_idx) {
     Thunk* target = get_dst(dst_idx);
     target->desc = (Desc*) __BOOL__;
@@ -37,6 +49,12 @@ void __eqI(int dst_idx) {
     target->_bool = readI(arg(2)) == readI(arg(1));
 }
 
+void __neqI(int dst_idx) {
+    Thunk* target = get_dst(dst_idx);
+    target->desc = (Desc*) __BOOL__;
+    target->_bool = readI(arg(2)) != readI(arg(1));
+}
+
 void __eqB(int dst_idx) {
     Thunk* target = get_dst(dst_idx);
     target->desc = (Desc*) __BOOL__;
@@ -49,6 +67,12 @@ void __not(int dst_idx) {
     target->_bool = !readB(arg(1));
 }
 
+void __mod(int dst_idx) {
+    Thunk* target = get_dst(dst_idx);
+    target->desc = (Desc*) __INT__;
+    target->_int = readB(arg(2)) % readB(arg(1));
+}
+
 void add_prim(int arity, int strictness, char* name, void (*exec)(int)) {
     int nameLength = strlen(name);
 
@@ -76,9 +100,13 @@ void add_prim(int arity, int strictness, char* name, void (*exec)(int)) {
 void init_prim() {
     add_prim(2, 3, "add", &__add);
     add_prim(2, 3, "sub", &__sub);
+    add_prim(2, 3, "mult", &__mult);
+    add_prim(2, 3, "div", &__div);
     add_prim(2, 3, "gt", &__gt);
     add_prim(2, 3, "lt", &__lt);
     add_prim(2, 3, "eqI", &__eqI);
+    add_prim(2, 3, "neqI", &__neqI);
     add_prim(2, 3, "eqB", &__eqB);
     add_prim(1, 1, "not", &__not);    
+    add_prim(2, 3, "mod", &__mod);    
 }

tests/Clean/Benchmarks.icl

+module Benchmarks
+
+import StdEnv
+
+:: List1 t = Nill | Cons t (List1 t)
+
+:: Tree t = Bin t (Tree t) (Tree t) | Empty
+
+
+
+cm Nill          = 0
+cm (Cons a Nill) = a
+cm (Cons a (Cons b Nill)) = a+b
+cm (Cons a (Cons b (Cons c Nill))) = a+b+c
+cm (Cons a (Cons b (Cons c (Cons d Nill)))) = a+b+c+d
+cm (Cons a (Cons b (Cons c (Cons d xs)))) = a+b+c+d + length1 xs
+
+length1 Nill = 0
+length1 (Cons x xs) = 1 + length1 xs
+
+mtest n = sum1 (map1 (\m -> cm (fromto 1 ( m  rem 10))) (fromto 1 n))
+matchtest n = sum1 (map1 mtest (fromto 1 n))
+
+take1 n Nill         = Nill
+take1 n (Cons x xs) |n==0 = Nill
+                    | otherwise  = Cons x (take1 (n-1) xs)
+
+drop1 n Nill         = Nill
+drop1 n (Cons x xs) | n==0 = Cons x xs
+                    | otherwise = drop1 (n-1) xs
+
+fr n = Cons n (fr (n+1))
+fromto n m = take1 (m-n+1) (fr n)
+
+append1 Nill         ys = ys
+append1 (Cons x xs) ys = Cons x (append1 xs ys)
+
+map1 f Nill         = Nill
+map1 f (Cons x xs) = Cons (f x) (map1 f xs)
+
+filter1 f Nill     = Nill
+filter1 f (Cons x xs) | f x       = Cons x (filter1 f xs)
+                      | otherwise = filter1 f xs
+
+sum1 Nill         = 0
+sum1 (Cons x xs) = x + sum1 xs
+
+listtotree Nill               = Empty
+listtotree (Cons x Nill)      = Bin x Empty Empty
+listtotree (Cons x xs)       = Bin x (listtotree (take1 ((length1 xs) / 2) xs)) (listtotree (drop1 ((length1 xs) / 2) xs))
+
+treetolist Empty       = Nill
+treetolist (Bin x l r) = Cons x (append1 (treetolist l) (treetolist r))
+
+sumtree Empty       = 0
+sumtree (Bin x l r) =  x + sumtree l + sumtree r
+
+depthtree Empty       = 0
+depthtree (Bin x l r) =  1 + max2 (depthtree l) (depthtree r)
+
+ltl xs = treetolist (listtotree xs)
+
+treetest n = sum1 (treetolist (listtotree (fromto 1 n)))
+treetest1 n = sumtree (listtotree (fromto 1 n))
+treetest2 n = depthtree (listtotree (fromto 1 n))
+
+rep1 n a | n==0 = Nill
+         | otherwise = (Cons a (rep1 (n-1) a))
+
+reptreetest n m = sum1 (map1 (\d -> (treetest m) rem d)  (fromto 2 n))
+
+el1 n (Cons a as) | n==0       = a
+                  | otherwise  = el1 (n-1) as
+
+merge1 Nill         ys          = ys
+merge1 xs           Nill        = xs
+merge1 (Cons a as) (Cons b bs) | a == b    = Cons a (merge1 as bs)
+                               | a < b     = Cons a (merge1 as (Cons b bs))
+                               | otherwise = Cons b (merge1 (Cons a as) bs)
+
+hamming k = let h =  Cons (f k) (merge1 (merge1 (map1 (mult 2) h) (map1 (mult 3) h)) (map1 (mult 5) h)) in h
+
+f k | k rem 2 == 0 = 1
+    | otherwise    = k rem 2
+
+mult a b = a * b
+
+max2 x y | x > y = x
+         | otherwise = y
+ 
+frominc n i = Cons n (frominc (n+i) i)
+mergetest  = merge1 (frominc 2 2) (frominc 0 3) 
+
+//rephamming n  = sum1 (map1 hm (fromto 1 n))
+rephamming n m = sum1 (map1 hm (rep1 n m))
+hm n =  (el1 n (hamming n)) rem  999
+
+tt k= let a = Cons k (map1 (\b -> b+1) a) in a
+
+sumrem Nill = 0
+sumrem (Cons a as) = (a +(sumrem as)) rem 7 
+
+test n = sum1 (map1 (el1 n) (rep1 n (tt 10)))
+
+fib n | n < 2 = 1
+      | otherwise = fib (n-2) + fib (n-1)
+
+//twice f x = f (f x) 
+//inc a =  a + 1
+cons x xs = Cons x xs
+tinc n = twice twice twice twice inc n
+reptwice n = sumrem (map1 tinc (fromto 1 n))        
+
+smaller x xs =  filter1 (\y.y < x) xs
+larger  x xs = filter1 (\y.y >= x) xs
+qsort Nill   = Nill
+qsort (Cons x xs) = append1 (qsort (smaller x xs)) (Cons x (qsort (larger x xs)))
+downto n m | m > n = Nill
+           | otherwise = Cons n (downto (n-1) m)
+sorttest n = sum1 (qsort (mklist n))
+sorttestu n = sum1 (qsort (fromto 1 n))
+sorttestd n = sum1 (qsort (downto n 1))
+repsort n = sum1 (map1 sorttest (fromto 1000 (1000 + n)))
+
+ins x Nill = Cons x Nill
+ins x (Cons y ys) | x <= y    = Cons x (Cons y ys)
+                  | otherwise = Cons y (ins x ys)
+isort Nill         = Nill
+isort (Cons x xs)  = ins x (isort xs)
+
+mergesort Nill          = Nill
+mergesort (Cons x Nill) = Cons x Nill
+mergesort (Cons x xs)   = let n = (length1 (Cons x xs))/ 2 in merge1 (mergesort (take1 n (Cons x xs))) (mergesort (drop1 n (Cons x xs)))
+
+fromdown n m = fd n m 0
+fd n m k | k == m      =  [] 
+         | otherwise   = [n+k:[m-k:fd n m (k+1)]] 
+
+quicksort [] = []
+quicksort [x:xs] = quicksort (filter (\y. y < x) xs) ++ [x: quicksort (filter (\y. y >= x) xs)]
+qsorttest n = sum (quicksort (fromdown 1 n))
+
+mklist n = mkl 0 n 0
+mkl _ _ 10 = Nill
+mkl m n k  = if (m < n) (Cons (m*10+k) (mkl (m+1) n k)) (mkl 0 n (k+1))
+
+queens n = length (qqueens n n)
+qqueens k 0 = [[]]
+//qqueens k n= [x:xs| xs <- qqueens k (n-1), x <- [1..k], safe xs 1 x]
+qqueens k n = flatten (map (recqq k) (qqueens k (n-1)))
+recqq k xs = mapfil (safe xs 1) (rcons xs) [1..k]
+
+mapfil p f []     = []
+mapfil p f [x:xs] | p x       = [f x : mapfil p f xs]
+                  | otherwise = mapfil p f xs
+
+safe [] d x     = True
+safe [y:ys] d x = x <> y && x+d <> y && x-d <> y && safe ys (d+1) x
+rcons xs x = [x:xs]
+
+:: Tuptype  a b = Tup a b
+
+knights1 n = doknights1 n (Cons (Tup 1 1) Nill)
+
+doknights1 n (Cons p ps)  | length1 ps+1  == n*n = Cons (Cons p ps) Nill
+                          | otherwise            = conc (map1 (\q -> doknights1 n (Cons q (Cons  p ps)))(moves1 n ps p))
+
+
+moves1 n as (Tup p q) = filter1 (legal1 n as) (Cons (Tup (p+1) (q+2)) (Cons (Tup (p+1)(q-2))(Cons (Tup (p-1)(q+2))(Cons (Tup (p-1)(q-2))
+                                        (Cons (Tup (p+2)(q+1))(Cons (Tup (p+2)(q-1))(Cons (Tup (p-2)(q+1))(Cons (Tup (p-2)(q-1)) Nill))))))))
+
+legal1 n as (Tup p q) = 1 <= p && p <= n && 1 <= q && q <= n && (notmemb as (Tup p q))
+
+notmemb Nill a = True
+notmemb (Cons x xs) a = neqtup a x && notmemb xs a
+
+neqtup (Tup a b) (Tup c d) = a<>c || b<>d
+
+conc Nill = Nill
+conc (Cons Nill yss) = conc yss
+conc (Cons (Cons z zs) yss)  = Cons z (conc (Cons zs yss))
+
+hd1 (Cons x xs) = x
+
+Start =  reptreetest 100 10000
+//Start =  (matchtest 2000)
+//Start =  (el1 10000000 mergetest)   
+//Start =  (fib 35)
+//Start =  (rephamming 10000 1000) 
+//Start =  (rephamming 4000 1000) 
+//Start = reptwice 400
+//Start = sorttestd 5000
+//Start = queens 11
+//Start =  sumrem (isort (mklist 1500))
+//Start =  sumrem (mergesort (mklist 25000))
+//Start = hd1 (knights1 5)
+

tests/Clean/Benchmarks.prj

+Version: 1.4
+Global
+	ProjectRoot:	.
+	Target:	iTasks
+	Exec:	{Project}\Benchmarks.exe
+	CodeGen
+		CheckStacks:	False
+		CheckIndexes:	True
+	Application
+		HeapSize:	2097152
+		StackSize:	512000
+		ExtraMemory:	81920
+		IntialHeapSize:	204800
+		HeapSizeMultiplier:	4096
+		ShowExecutionTime:	True
+		ShowGC:	False
+		ShowStackSize:	False
+		MarkingCollector:	False
+		StandardRuntimeEnv:	True
+		Profile
+			Memory:	False
+			MemoryMinimumHeapSize:	0
+			Time:	False
+			Stack:	False
+		Output
+			Output:	ShowConstructors
+			Font:	Courier
+			FontSize:	9
+			WriteStdErr:	False
+	Link
+		LinkMethod:	Static
+		GenerateRelocations:	False
+		GenerateLinkMap:	False
+		LinkResources:	False
+		ResourceSource:	
+		GenerateDLL:	False
+		ExportedNames:	
+	Paths
+		Path:	{Project}
+	Precompile:	
+	Postlink:	
+MainModule
+	Name:	Benchmarks
+	Dir:	{Project}
+	Compiler
+		NeverMemoryProfile:	False
+		NeverTimeProfile:	False
+		StrictnessAnalysis:	True
+		ListTypes:	StrictExportTypes
+		ListAttributes:	True
+		Warnings:	True
+		Verbose:	True
+		ReadableABC:	False
+		ReuseUniqueNodes:	True
+		Fusion:	False
+OtherModules
+	Module
+		Name:	StdArray
+		Dir:	{Application}\Libraries\StdEnv
+		Compiler
+			NeverMemoryProfile:	False
+			NeverTimeProfile:	False
+			StrictnessAnalysis:	True
+			ListTypes:	StrictExportTypes
+			ListAttributes:	True
+			Warnings:	True
+			Verbose:	True
+			ReadableABC:	False
+			ReuseUniqueNodes:	True
+			Fusion:	False
+	Module
+		Name:	StdBool
+		Dir:	{Application}\Libraries\StdEnv
+		Compiler
+			NeverMemoryProfile:	False
+			NeverTimeProfile:	False
+			StrictnessAnalysis:	True
+			ListTypes:	StrictExportTypes
+			ListAttributes:	True
+			Warnings:	True
+			Verbose:	True
+			ReadableABC:	False
+			ReuseUniqueNodes:	True
+			Fusion:	False
+	Module
+		Name:	StdChar
+		Dir:	{Application}\Libraries\StdEnv
+		Compiler
+			NeverMemoryProfile:	False
+			NeverTimeProfile:	False
+			StrictnessAnalysis:	True
+			ListTypes:	StrictExportTypes
+			ListAttributes:	True
+			Warnings:	True
+			Verbose:	True
+			ReadableABC:	False
+			ReuseUniqueNodes:	True
+			Fusion:	False
+	Module
+		Name:	StdCharList
+		Dir:	{Application}\Libraries\StdEnv
+		Compiler
+			NeverMemoryProfile:	False
+			NeverTimeProfile:	False
+			StrictnessAnalysis:	True
+			ListTypes:	StrictExportTypes
+			ListAttributes:	True
+			Warnings:	True
+			Verbose:	True
+			ReadableABC:	False
+			ReuseUniqueNodes:	True
+			Fusion:	False
+	Module
+		Name:	StdClass
+		Dir:	{Application}\Libraries\StdEnv
+		Compiler
+			NeverMemoryProfile:	False
+			NeverTimeProfile:	False
+			StrictnessAnalysis:	True
+			ListTypes:	StrictExportTypes
+			ListAttributes:	True
+			Warnings:	True
+			Verbose:	True
+			ReadableABC:	False
+			ReuseUniqueNodes:	True
+			Fusion:	False
+	Module
+		Name:	StdEnum
+		Dir:	{Application}\Libraries\StdEnv
+		Compiler
+			NeverMemoryProfile:	False
+			NeverTimeProfile:	False
+			StrictnessAnalysis:	True
+			ListTypes:	StrictExportTypes
+			ListAttributes:	True
+			Warnings:	True
+			Verbose:	True
+			ReadableABC:	False
+			ReuseUniqueNodes:	True
+			Fusion:	False
+	Module
+		Name:	StdEnv
+		Dir:	{Application}\Libraries\StdEnv
+		Compiler
+			NeverMemoryProfile:	False
+			NeverTimeProfile:	False
+			StrictnessAnalysis:	True
+			ListTypes:	StrictExportTypes
+			ListAttributes:	True
+			Warnings:	True
+			Verbose:	True
+			ReadableABC:	False
+			ReuseUniqueNodes:	True
+			Fusion:	False
+	Module
+		Name:	StdFile
+		Dir:	{Application}\Libraries\StdEnv
+		Compiler
+			NeverMemoryProfile:	False
+			NeverTimeProfile:	False
+			StrictnessAnalysis:	True
+			ListTypes:	StrictExportTypes
+			ListAttributes:	True
+			Warnings:	True
+			Verbose:	True
+			ReadableABC:	False
+			ReuseUniqueNodes:	True
+			Fusion:	False
+	Module
+		Name:	StdFunc
+		Dir:	{Application}\Libraries\StdEnv
+		Compiler
+			NeverMemoryProfile:	False
+			NeverTimeProfile:	False
+			StrictnessAnalysis:	True
+			ListTypes:	StrictExportTypes
+			ListAttributes:	True
+			Warnings:	True
+			Verbose:	True
+			ReadableABC:	False
+			ReuseUniqueNodes:	True
+			Fusion:	False
+	Module
+		Name:	StdInt
+		Dir:	{Application}\Libraries\StdEnv
+		Compiler
+			NeverMemoryProfile:	False
+			NeverTimeProfile:	False
+			StrictnessAnalysis:	True
+			ListTypes:	StrictExportTypes
+			ListAttributes:	True
+			Warnings:	True
+			Verbose:	True
+			ReadableABC:	False
+			ReuseUniqueNodes:	True
+			Fusion:	False
+	Module
+		Name:	StdList
+		Dir:	{Application}\Libraries\StdEnv
+		Compiler
+			NeverMemoryProfile:	False
+			NeverTimeProfile:	False
+			StrictnessAnalysis:	True
+			ListTypes:	StrictExportTypes
+			ListAttributes:	True
+			Warnings:	True
+			Verbose:	True
+			ReadableABC:	False
+			ReuseUniqueNodes:	True
+			Fusion:	False
+	Module
+		Name:	StdMisc
+		Dir:	{Application}\Libraries\StdEnv
+		Compiler
+			NeverMemoryProfile:	False
+			NeverTimeProfile:	False
+			StrictnessAnalysis:	True
+			ListTypes:	StrictExportTypes
+			ListAttributes:	True
+			Warnings:	True
+			Verbose:	True
+			ReadableABC:	False
+			ReuseUniqueNodes:	True
+			Fusion:	False
+	Module
+		Name:	StdOrdList
+		Dir:	{Application}\Libraries\StdEnv
+		Compiler
+			NeverMemoryProfile:	False
+			NeverTimeProfile:	False
+			StrictnessAnalysis:	True
+			ListTypes:	StrictExportTypes
+			ListAttributes:	True
+			Warnings:	True
+			Verbose:	True
+			ReadableABC:	False
+			ReuseUniqueNodes:	True
+			Fusion:	False
+	Module
+		Name:	StdOverloaded
+		Dir:	{Application}\Libraries\StdEnv
+		Compiler
+			NeverMemoryProfile:	False
+			NeverTimeProfile:	False
+			StrictnessAnalysis:	True
+			ListTypes:	StrictExportTypes