Commit de9bc49a authored by Laszlo Domoszlai's avatar Laszlo Domoszlai
Browse files

Adjoxo works now

parent fce659b3
......@@ -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;
......
......@@ -8,7 +8,6 @@
#include "code.h"
#include "desc.h"
int parseInt(char** ptr, int* result) {
char *end;
*result = strtol(*ptr, &end, 10);
......
......@@ -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);
......
......@@ -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
......
......@@ -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"
......
[D]
\ No newline at end of file
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)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment