Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-and-itasks
sapl-interpreter
Commits
de9bc49a
Commit
de9bc49a
authored
Aug 28, 2015
by
Laszlo Domoszlai
Browse files
Adjoxo works now
parent
fce659b3
Changes
7
Hide whitespace changes
Inline
Side-by-side
interpreter/code.c
View file @
de9bc49a
...
...
@@ -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
View file @
de9bc49a
...
...
@@ -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
View file @
de9bc49a
...
...
@@ -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
View file @
de9bc49a
...
...
@@ -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
View file @
de9bc49a
...
...
@@ -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
0 → 100644
View file @
de9bc49a
[D]
\ No newline at end of file
tests/Adjoxo.sapl
0 → 100644
View file @
de9bc49a
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)
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment