Adjoxo works now

interpreter/code.c

@@ -89,30 +89,65 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
 
             if (var->base.local_type == VAR_LOCAL) 
             {
-                // TODO: force
-                
                 Thunk* basethunk = eval(local(frame_ptr, var->index));
 
                 Desc* slice =
                         get_slice(basethunk->desc->type == FT_SLICE ?
                                   ((SliceEntry*) basethunk->desc)->forward_ptr : basethunk->desc, basethunk->desc->arity + expr->nr_args);
 
-                Thunk* thunk = updateF(get_dst(root_frame_ptr), slice);
+                if(slice->type == FT_PRIM)
+                {
+                    for (int i = 0; i < basethunk->desc->arity; i++) {
+                        // TODO: eval
+                        push_a(basethunk->_args[i]);
+                    }
+                    
+                    for (int i = 0; i < expr->nr_args; i++) {
+                        push_a(NULL);
+                        exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a);
+                    } 
+                    
+                    ((PrimEntry*) slice)->exec(root_frame_ptr);
+                    destroy_stack_frame(root_frame_ptr);
+                    return;                    
+                }
+                else if(slice->type == FT_FUN)
+                {
+                    int new_frame_ptr = stack_top_a;                    
+                    
+                    for (int i = 0; i < basethunk->desc->arity; i++) {
+                        // TODO: eval
+                        push_a(basethunk->_args[i]);
+                    }
+                    
+                    for (int i = 0; i < expr->nr_args; i++) {
+                        // TODO: eval
+                        push_a(create_thunk(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a));
+                    } 
+                    
+                    expr = ((FunEntry*) slice)->body;
+                    frame_ptr = new_frame_ptr;
+                    continue;                    
+                }
+                else
+                {
+                    Thunk* thunk = updateF(get_dst(root_frame_ptr), slice);
 
-                assert(thunk->desc->arity == basethunk->desc->arity + expr->nr_args);            
+                    assert(thunk->desc->arity == basethunk->desc->arity + expr->nr_args);            
 
-                for (int i = 0; i < basethunk->desc->arity; i++) {
-                    thunk->_args[i] = basethunk->_args[i];
-                }
+                    for (int i = 0; i < basethunk->desc->arity; i++) {
+                        thunk->_args[i] = basethunk->_args[i];
+                    }
 
-                for (int i = 0; i < expr->nr_args; i++) {
-                    thunk->_args[basethunk->desc->arity + i] 
-                            = create_thunk(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a);
+                    for (int i = 0; i < expr->nr_args; i++) {
+                        thunk->_args[basethunk->desc->arity + i] 
+                                = create_thunk(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a);
+                    }
+                    
+                    set_return(root_frame_ptr, thunk);
+                    destroy_stack_frame(root_frame_ptr);
+                    return;                    
                 }
-
-                set_return(root_frame_ptr, thunk);
-                destroy_stack_frame(root_frame_ptr);
-                return;
             }
             else
             {
@@ -234,12 +269,13 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
             exec(((SelectEntry*) expr)->expr, frame_ptr, stack_top_a);
             Thunk* pattern = eval(pop_a());
 
+            assert(is_hnf(pattern));
+            assert(pattern->desc->type == FT_ADT);            
+            
             bool handled = false;
             
             for (int i = 0; i < expr->nr_cases; i++) {
                 SelectCaseEntry* caseEntry = &((SelectEntry*) expr)->cases[i];
-
-                assert(pattern->desc->type == FT_ADT);
                 
                 if (caseEntry->type == SC_CONS) {
                     // Pattern match
@@ -275,7 +311,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
             push_a(&tmp);
             exec(((IfEntry*) expr)->cond, frame_ptr, stack_top_a);
             Thunk* cond = eval(pop_a());
-
+            
             if (readB(cond)) {
                 expr = ((IfEntry*) expr)->texpr;
                 continue;                

interpreter/parse.c

@@ -8,7 +8,6 @@
 #include "code.h"
 #include "desc.h"
 
-
 int parseInt(char** ptr, int* result) {
     char *end;
     *result = strtol(*ptr, &end, 10);

interpreter/thunk.c

@@ -113,6 +113,11 @@ struct Thunk* updateF(Thunk* target, Desc* f) {
     return thunk;
 }
 
+bool is_hnf(Thunk* thunk)
+{
+    return !(thunk->desc->type == FT_FUN || thunk->desc->type == FT_PRIM);
+}
+
 struct Thunk* eval(Thunk* thunk) {
     assert(thunk != NULL);    
     
@@ -164,6 +169,8 @@ void print(Thunk* thunk, bool force) {
             } else {
                 printf("False");
             }
+        } else if ((FunEntry*) thunk->desc == __CHAR__) {
+            printf("%c", thunk->_char);
         } else {
             printf("print: unhandled BOXED LIT\n");
             printDesc(thunk->desc);

interpreter/thunk.h

@@ -39,6 +39,8 @@ struct Thunk* updateT(Thunk* target, Thunk* source);
 
 struct Thunk* updateF(Thunk* target, Desc* f);
 
+bool is_hnf(Thunk* thunk);
+
 struct Thunk* eval(Thunk* thunk);
 
 // Thunk is supposed to be in HNF

precompiler/precompiler.icl

@@ -9,7 +9,7 @@ import Text.StringAppender, Text
 import Data.Map
 
 import Text.Unicode.Encodings.JS
-//import Text.Unicode.UChar
+from Text.Unicode.UChar import instance toChar UChar
 
 import System.CommandLine
 import System.File
@@ -84,6 +84,7 @@ where
 	(<++) a (LString lit) = a <++ "S" <++ sText (toJSLiteral lit)
 	(<++) a (LInt lit) = a <++ "I" <++ sNum lit
 	(<++) a (LReal lit) = a <++ "R" <++ sNum lit
+	(<++) a (LChar [c]) = a <++ "C" <++ toString (toChar c)
 	(<++) a (LBool True) = a <++ "1"
 	(<++) a (LBool False) = a <++ "0"
 

tests/Adjoxo.exp

+[D]
\ No newline at end of file

tests/Adjoxo.sapl

+main = Adjoxo.Start
+Adjoxo.Start = Adjoxo.adjudicate Flite.Nil Flite.Nil
+:: Flite.List = Flite.Nil | Flite.Cons a1 a2
+Adjoxo.adjudicate !os_0 !xs_1 = <{Adjoxo._c;88;3_39}> (Adjoxo.cmp_33 (Adjoxo.len os_0) (Adjoxo.len xs_1)) xs_1 os_0
+Adjoxo.len !_x_0 = select _x_0 (Flite.Nil -> 0) (Flite.Cons x_1_0 xs_1_1 -> add 1 (Adjoxo.len xs_1_1)) 
+Adjoxo.cmp_33 !a_0 !b_1 = if (eqI a_0 b_1) Flite.EQ (if (<{Adjoxo.<=_30}> a_0 b_1) Flite.LT Flite.GT)
+:: Flite.Ordering = Flite.LT | Flite.EQ | Flite.GT
+<{Adjoxo.<=_30}> !x_0 !y_1 = not (lt y_1 x_0)
+<{Adjoxo._c;88;3_39}> !_x_0 xs_1 os_2 = select _x_0 (Flite.GT -> Adjoxo.report (Adjoxo.analysis xs_1 os_2) Adjoxo.X) (Flite.EQ -> if (Adjoxo.hasLine xs_1) (Adjoxo.report Adjoxo.Win Adjoxo.X) (if (Adjoxo.hasLine os_2) (Adjoxo.report Adjoxo.Win Adjoxo.O) (Adjoxo.report (Adjoxo.analysis xs_1 os_2) Adjoxo.X))) (Flite.LT -> Adjoxo.report (Adjoxo.analysis os_2 xs_1) Adjoxo.O) 
+:: Adjoxo.Side = Adjoxo.X | Adjoxo.O
+Adjoxo.analysis ap_0 !pp_1 = if (Adjoxo.hasLine pp_1) Adjoxo.Loss (if (Adjoxo.gridFull ap_0 pp_1) Adjoxo.Draw (Adjoxo.foldr1 Adjoxo.bestOf (Adjoxo.map (Adjoxo.moveval ap_0 pp_1) (Adjoxo.diff_32 (Adjoxo.diff_32 (Adjoxo.fromTo 1 9) ap_0) pp_1))))
+Adjoxo.fromTo !n_0 !m_1 = if (<{Adjoxo.<=_26}> n_0 m_1) (Flite.Cons n_0 (Adjoxo.fromTo (add n_0 1) m_1)) Flite.Nil
+<{Adjoxo.<=_26}> !x_0 !y_1 = not (lt y_1 x_0)
+Adjoxo.diff_32 !_x_0 ys_1 = select _x_0 (Flite.Nil -> Flite.Nil) (Flite.Cons x_1_0 xs_1_1 -> select ys_1 (Flite.Nil -> Flite.Cons x_1_0 xs_1_1) (Flite.Cons y_2_0 ys_2_1 -> <{Adjoxo._c;45;3_38}> (Adjoxo.cmp_33 x_1_0 y_2_0) x_1_0 xs_1_1 y_2_0 ys_2_1) ) 
+<{Adjoxo._c;45;3_38}> !_x_0 x_1 xs_2 y_3 ys_4 = select _x_0 (Flite.LT -> Flite.Cons x_1 (Adjoxo.diff_32 xs_2 (Flite.Cons y_3 ys_4))) (Flite.EQ -> Adjoxo.diff_32 xs_2 ys_4) (Flite.GT -> Adjoxo.diff_32 (Flite.Cons x_1 xs_2) ys_4) 
+Adjoxo.moveval !ap_0 pp_1 !m_2 = Adjoxo.inverse (Adjoxo.analysis pp_1 (Adjoxo.insert_34 m_2 ap_0))
+Adjoxo.insert_34 x_0 !_x_1 = select _x_1 (Flite.Nil -> Flite.Cons x_0 Flite.Nil) (Flite.Cons y_1_0 ys_1_1 -> if (<{Adjoxo.<=_35}> x_0 y_1_0) (Flite.Cons x_0 (Flite.Cons y_1_0 ys_1_1)) (Flite.Cons y_1_0 (Adjoxo.insert_34 x_0 ys_1_1))) 
+<{Adjoxo.<=_35}> !x_0 !y_1 = not (lt y_1 x_0)
+Adjoxo.inverse !_x_0 = select _x_0 (Adjoxo.Loss -> Adjoxo.Win) (Adjoxo.Draw -> Adjoxo.Draw) (Adjoxo.Win -> Adjoxo.Loss) 
+:: Adjoxo.Result = Adjoxo.Win | Adjoxo.Draw | Adjoxo.Loss
+Adjoxo.map f_0 !_x_1 = select _x_1 (Flite.Nil -> Flite.Nil) (Flite.Cons x_1_0 xs_1_1 -> Flite.Cons (f_0 x_1_0) (Adjoxo.map f_0 xs_1_1)) 
+Adjoxo.bestOf !_x_0 v_1 = select _x_0 (Adjoxo.Win -> Adjoxo.Win) (Adjoxo.Loss -> v_1) (Adjoxo.Draw -> select v_1 (Adjoxo.Win -> Adjoxo.Win) (Adjoxo.Draw -> Adjoxo.Draw) (Adjoxo.Loss -> Adjoxo.Draw) ) 
+Adjoxo.foldr1 f_0 !_x_1 = select _x_1 (Flite.Cons x_1_0 _x_1_1 -> select _x_1_1 (Flite.Nil -> x_1_0) (Flite.Cons y_2_0 ys_2_1 -> f_0 x_1_0 (Adjoxo.foldr1 f_0 (Flite.Cons y_2_0 ys_2_1))) ) 
+Adjoxo.gridFull !ap_0 !pp_1 = eqI (add (Adjoxo.len ap_0) (Adjoxo.len pp_1)) 9
+Adjoxo.hasLine !p_0 = Adjoxo.or (Adjoxo.subset_31 (Flite.Cons 1 (Flite.Cons 2 (Flite.Cons 3 Flite.Nil))) p_0) (Adjoxo.or (Adjoxo.subset_31 (Flite.Cons 4 (Flite.Cons 5 (Flite.Cons 6 Flite.Nil))) p_0) (Adjoxo.or (Adjoxo.subset_31 (Flite.Cons 7 (Flite.Cons 8 (Flite.Cons 9 Flite.Nil))) p_0) (Adjoxo.or (Adjoxo.subset_31 (Flite.Cons 1 (Flite.Cons 4 (Flite.Cons 7 Flite.Nil))) p_0) (Adjoxo.or (Adjoxo.subset_31 (Flite.Cons 2 (Flite.Cons 5 (Flite.Cons 8 Flite.Nil))) p_0) (Adjoxo.or (Adjoxo.subset_31 (Flite.Cons 3 (Flite.Cons 6 (Flite.Cons 9 Flite.Nil))) p_0) (Adjoxo.or (Adjoxo.subset_31 (Flite.Cons 1 (Flite.Cons 5 (Flite.Cons 9 Flite.Nil))) p_0) (Adjoxo.subset_31 (Flite.Cons 3 (Flite.Cons 5 (Flite.Cons 7 Flite.Nil))) p_0)))))))
+Adjoxo.subset_31 !xs_0 ys_1 = Adjoxo.null (Adjoxo.diff_32 xs_0 ys_1)
+Adjoxo.null !_x_0 = select _x_0 (Flite.Nil -> True) (Flite.Cons x_1_0 xs_1_1 -> False) 
+Adjoxo.or !_x_0 x_1 = if _x_0 True x_1
+Adjoxo.report !_x_0 s_1 = select _x_0 (Adjoxo.Loss -> Adjoxo.side (Adjoxo.opp s_1)) (Adjoxo.Win -> Adjoxo.side s_1) (Adjoxo.Draw -> 'D') 
+Adjoxo.side !_x_0 = select _x_0 (Adjoxo.O -> 'O') (Adjoxo.X -> 'X') 
+Adjoxo.opp !_x_0 = select _x_0 (Adjoxo.O -> Adjoxo.X) (Adjoxo.X -> Adjoxo.O)