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
6ca85fbb
Commit
6ca85fbb
authored
Aug 21, 2015
by
Laszlo Domoszlai
Browse files
save progress. BROKEN!
parent
8357b7be
Changes
12
Expand all
Hide whitespace changes
Inline
Side-by-side
interpreter/Makefile
0 → 100644
View file @
6ca85fbb
TARGET
=
main
LIBS
=
CC
=
g++
CFLAGS
=
-g
-Wno-write-strings
.PHONY
:
default all clean
default
:
$(TARGET)
all
:
default
OBJECTS
=
$(
patsubst
%.c, %.o,
$(
wildcard
*
.c
))
HEADERS
=
$(
wildcard
*
.h
)
%.o
:
%.c $(HEADERS)
$(CC)
$(CFLAGS)
-c
$<
-o
$@
.PRECIOUS
:
$(TARGET) $(OBJECTS)
$(TARGET)
:
$(OBJECTS)
$(CC)
$(OBJECTS)
-g
-Wall
$(LIBS)
-o
$@
clean
:
-
rm
-f
*
.o
-
rm
-f
$(TARGET)
\ No newline at end of file
interpreter/code.c
View file @
6ca85fbb
#include
<stdio.h>
#include
<stdlib.h>
#include
<stdbool.h>
#include
"code.h"
#include
"desc.h"
#include
"thunk.h"
#include
"mem.h"
struct
Thunk
*
exec
(
Code
*
expr
,
int
frame_ptr
,
Thunk
*
target
)
{
switch
(
expr
->
type
)
{
case
CT_LIT
:
switch
(
expr
->
local_type
)
{
case
LIT_INT
:
return
updateI
(
target
,
((
LitEntry
*
)
expr
)
->
_int
);
case
LIT_BOOL
:
return
updateB
(
target
,
((
LitEntry
*
)
expr
)
->
_bool
);
default:
printf
(
"Exec: Unhandled LIT type"
);
exit
(
-
1
);
}
break
;
case
CT_VAR
:
switch
(
expr
->
local_type
)
{
case
VAR_FN
:
return
updateF
(
target
,
get_slice
(((
VarEntry
*
)
expr
)
->
f
,
0
));
case
VAR_ARG
:
{
Thunk
*
var
=
stack
[
frame_ptr
-
((
VarEntry
*
)
expr
)
->
index
];
return
forward_to
(
target
,
var
);
}
case
VAR_LOCAL
:
{
Thunk
*
var
=
stack
[
frame_ptr
+
((
VarEntry
*
)
expr
)
->
index
+
1
];
return
forward_to
(
target
,
var
);
}
}
break
;
case
CT_APP
:
// TODO: check over application
// TODO: enforce strictness in ADT/Record
VarEntry
*
var
;
var
=
((
AppEntry
*
)
expr
)
->
var
;
Thunk
*
thunk
;
switch
(
var
->
base
.
local_type
)
{
case
VAR_FN
:
thunk
=
updateF
(
target
,
get_slice
(
var
->
f
,
expr
->
nr_args
));
for
(
int
i
=
0
;
i
<
thunk
->
desc
->
arity
;
i
++
)
{
thunk
->
_args
[
i
]
=
exec
(((
AppEntry
*
)
expr
)
->
args
[
i
],
frame_ptr
,
NULL
);
}
return
thunk
;
case
VAR_ARG
:
Thunk
*
basethunk
;
basethunk
=
stack
[
frame_ptr
-
var
->
index
];
eval
(
basethunk
);
thunk
=
updateF
(
target
,
get_slice
(
basethunk
->
desc
->
type
==
FT_SLICE
?
((
SliceEntry
*
)
basethunk
->
desc
)
->
forward_ptr
:
basethunk
->
desc
,
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
<
expr
->
nr_args
;
i
++
)
{
thunk
->
_args
[
basethunk
->
desc
->
arity
+
i
]
=
exec
(((
AppEntry
*
)
expr
)
->
args
[
i
],
frame_ptr
,
NULL
);
}
return
thunk
;
default:
printf
(
"Exec: Unhandled VAR type in CT_APP"
);
exit
(
-
1
);
}
break
;
case
CT_SELECT
:
{
Thunk
*
pattern
=
exec
(((
SelectEntry
*
)
expr
)
->
expr
,
frame_ptr
,
NULL
);
pattern
=
eval
(
pattern
);
for
(
int
i
=
0
;
i
<
expr
->
nr_cases
;
i
++
)
{
SelectCaseEntry
*
caseEntry
=
&
((
SelectEntry
*
)
expr
)
->
cases
[
i
];
switch
(
caseEntry
->
type
)
{
case
SC_CONS
:
// Pattern match
if
((
Desc
*
)
caseEntry
->
cons
!=
pattern
->
desc
)
continue
;
// Put the constructor arguments to the stack if matches
for
(
int
i
=
0
;
i
<
pattern
->
desc
->
arity
;
i
++
)
{
pushs
(
pattern
->
_args
[
i
]);
}
// Fall through on purpose
case
SC_DEFAULT
:
return
exec
(
caseEntry
->
body
,
frame_ptr
,
target
);
default:
printf
(
"Exec: Unhandled entry type in CT_SELECT"
);
exit
(
-
1
);
}
}
printf
(
"Exec: no select cases matches"
);
print
(
pattern
,
false
);
exit
(
-
1
);
}
case
CT_IF
:
{
//Thunk* tmp = (Thunk*) malloc(sizeof(Thunk) + 8);
//tmp->desc = (Desc*) find_desc("add");
Thunk
*
cond
=
exec
(((
IfEntry
*
)
expr
)
->
cond
,
frame_ptr
,
NULL
);
cond
=
eval
(
cond
);
if
(
readB
(
cond
))
{
return
exec
(((
IfEntry
*
)
expr
)
->
texpr
,
frame_ptr
,
target
);
}
else
{
return
exec
(((
IfEntry
*
)
expr
)
->
fexpr
,
frame_ptr
,
target
);
}
}
default:
printf
(
"Exec: Unhandled CODE type"
);
exit
(
-
1
);
}
struct
Thunk
*
exec
(
Code
*
expr
,
int
frame_ptr
,
Thunk
*
target
,
bool
force
)
{
switch
(
expr
->
type
)
{
case
CT_LIT
:
switch
(
expr
->
local_type
)
{
case
LIT_INT
:
return
updateI
(
target
,
((
LitEntry
*
)
expr
)
->
_int
);
case
LIT_BOOL
:
return
updateB
(
target
,
((
LitEntry
*
)
expr
)
->
_bool
);
default:
printf
(
"Exec: Unhandled LIT type"
);
exit
(
-
1
);
}
break
;
case
CT_VAR
:
switch
(
expr
->
local_type
)
{
case
VAR_FN
:
return
updateF
(
target
,
get_slice
(((
VarEntry
*
)
expr
)
->
f
,
0
));
case
VAR_ARG
:
{
Thunk
*
var
=
stack
[
frame_ptr
-
((
VarEntry
*
)
expr
)
->
index
];
return
forward_to
(
target
,
var
);
}
case
VAR_LOCAL
:
{
Thunk
*
var
=
stack
[
frame_ptr
+
((
VarEntry
*
)
expr
)
->
index
+
1
];
return
forward_to
(
target
,
var
);
}
}
break
;
case
CT_APP
:
// TODO: check over application
// TODO: enforce strictness in ADT/Record
VarEntry
*
var
;
var
=
((
AppEntry
*
)
expr
)
->
var
;
Thunk
*
thunk
;
switch
(
var
->
base
.
local_type
)
{
case
VAR_FN
:
{
Desc
*
slice
=
get_slice
(
var
->
f
,
expr
->
nr_args
);
if
(
force
&&
slice
->
type
==
FT_PRIM
)
{
Thunk
args
[
expr
->
nr_args
];
for
(
int
i
=
0
;
i
<
expr
->
nr_args
;
i
++
)
{
exec
(((
AppEntry
*
)
expr
)
->
args
[
i
],
frame_ptr
,
&
args
[
i
],
true
);
}
int
old_top
=
stack_top
;
for
(
int
i
=
0
;
i
<
expr
->
nr_args
;
i
++
)
{
pushs
(
&
args
[
i
]);
}
thunk
=
((
PrimEntry
*
)
slice
)
->
exec
(
target
);
stack_top
=
old_top
;
}
else
if
(
force
&&
slice
->
type
==
FT_FUN
)
{
Thunk
*
args
[
expr
->
nr_args
];
for
(
int
i
=
0
;
i
<
expr
->
nr_args
;
i
++
)
{
args
[
i
]
=
exec
(((
AppEntry
*
)
expr
)
->
args
[
i
],
frame_ptr
,
NULL
,
false
);
}
int
old_top
=
stack_top
;
for
(
int
i
=
0
;
i
<
expr
->
nr_args
;
i
++
)
{
pushs
(
args
[
i
]);
}
printf
(
"name: %s
\n
"
,
((
FunEntry
*
)
slice
)
->
name
);
printf
(
"target: %d
\n
"
,
target
);
thunk
=
exec
(((
FunEntry
*
)
slice
)
->
body
,
stack_top
,
target
,
false
);
stack_top
=
old_top
;
}
else
{
thunk
=
updateF
(
target
,
slice
);
for
(
int
i
=
0
;
i
<
expr
->
nr_args
;
i
++
)
{
thunk
->
_args
[
i
]
=
exec
(((
AppEntry
*
)
expr
)
->
args
[
i
],
frame_ptr
,
NULL
,
false
);
}
}
return
thunk
;
}
case
VAR_ARG
:
{
Thunk
*
basethunk
=
eval
(
stack
[
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
=
updateF
(
target
,
slice
);
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
]
=
exec
(((
AppEntry
*
)
expr
)
->
args
[
i
],
frame_ptr
,
NULL
,
false
);
}
return
thunk
;
}
default:
printf
(
"Exec: Unhandled VAR type in CT_APP"
);
exit
(
-
1
);
}
break
;
case
CT_SELECT
:
{
Thunk
*
pattern
=
exec
(((
SelectEntry
*
)
expr
)
->
expr
,
frame_ptr
,
NULL
,
true
);
pattern
=
eval
(
pattern
);
for
(
int
i
=
0
;
i
<
expr
->
nr_cases
;
i
++
)
{
SelectCaseEntry
*
caseEntry
=
&
((
SelectEntry
*
)
expr
)
->
cases
[
i
];
switch
(
caseEntry
->
type
)
{
case
SC_CONS
:
// Pattern match
if
((
Desc
*
)
caseEntry
->
cons
!=
pattern
->
desc
)
continue
;
// Put the constructor arguments to the stack if matches
for
(
int
i
=
0
;
i
<
pattern
->
desc
->
arity
;
i
++
)
{
pushs
(
pattern
->
_args
[
i
]);
}
// Fall through on purpose
case
SC_DEFAULT
:
return
exec
(
caseEntry
->
body
,
frame_ptr
,
target
,
false
);
default:
printf
(
"Exec: Unhandled entry type in CT_SELECT"
);
exit
(
-
1
);
}
}
printf
(
"Exec: no select cases matches"
);
print
(
pattern
,
false
);
exit
(
-
1
);
}
case
CT_IF
:
{
Thunk
*
tmp
=
(
Thunk
*
)
malloc
(
sizeof
(
Thunk
));
tmp
->
desc
=
(
Desc
*
)
__BOOL__
;
Thunk
*
cond
=
exec
(((
IfEntry
*
)
expr
)
->
cond
,
frame_ptr
,
NULL
,
true
);
cond
=
eval
(
cond
);
if
(
readB
(
cond
))
{
return
exec
(((
IfEntry
*
)
expr
)
->
texpr
,
frame_ptr
,
target
,
force
);
}
else
{
return
exec
(((
IfEntry
*
)
expr
)
->
fexpr
,
frame_ptr
,
target
,
force
);
}
}
default:
printf
(
"Exec: Unhandled CODE type"
);
exit
(
-
1
);
}
}
\ No newline at end of file
interpreter/code.h
View file @
6ca85fbb
...
...
@@ -10,12 +10,11 @@
#define CT_SELECT 4
#define CT_IF 5
struct
Code
{
unsigned
int
type
:
3
;
unsigned
int
local_type
:
3
;
unsigned
int
nr_args
:
5
;
// used in AppEntry
unsigned
int
nr_cases
:
5
;
// used in SelectEntry
struct
Code
{
unsigned
int
type
:
3
;
unsigned
int
local_type
:
3
;
unsigned
int
nr_args
:
5
;
// used in AppEntry
unsigned
int
nr_cases
:
5
;
// used in SelectEntry
};
#define LIT_INT 1
...
...
@@ -24,76 +23,69 @@ struct Code
#define LIT_BOOL 4
#define LIT_STRING 5
struct
CleanString
{
int
length
;
char
chars
[];
struct
CleanString
{
int
length
;
char
chars
[];
};
struct
LitEntry
{
struct
Code
base
;
union
{
int
_int
;
double
_real
;
char
_char
;
int
_bool
;
struct
CleanString
_string
;
};
struct
LitEntry
{
struct
Code
base
;
union
{
int
_int
;
double
_real
;
char
_char
;
int
_bool
;
struct
CleanString
_string
;
};
};
#define VAR_ARG 1
#define VAR_LOCAL 2
#define VAR_FN 3
struct
VarEntry
{
struct
Code
base
;
union
{
int
index
;
// index on the stack
struct
Desc
*
f
;
};
struct
VarEntry
{
struct
Code
base
;
union
{
int
index
;
// index on the stack
struct
Desc
*
f
;
};
};
struct
AppEntry
{
struct
Code
base
;
struct
VarEntry
*
var
;
// TODO: remove * here (embed VarEntry to save a space of one pointer)
struct
Code
*
args
[];
struct
AppEntry
{
struct
Code
base
;
struct
VarEntry
*
var
;
// TODO: remove * here (embed VarEntry to save a space of one pointer)
struct
Code
*
args
[];
};
#define SC_CONS 1
#define SC_LIT 2
#define SC_DEFAULT 3
struct
SelectCaseEntry
{
int
type
;
struct
Code
*
body
;
union
{
struct
ADTEntry
*
cons
;
struct
LitEntry
*
lit
;
};
struct
SelectCaseEntry
{
int
type
;
struct
Code
*
body
;
union
{
struct
ADTEntry
*
cons
;
struct
LitEntry
*
lit
;
};
};
struct
SelectEntry
{
struct
Code
base
;
struct
Code
*
expr
;
struct
SelectCaseEntry
cases
[];
struct
SelectEntry
{
struct
Code
base
;
struct
Code
*
expr
;
struct
SelectCaseEntry
cases
[];
};
struct
IfEntry
{
struct
Code
base
;
struct
Code
*
cond
;
struct
Code
*
texpr
;
struct
Code
*
fexpr
;
struct
IfEntry
{
struct
Code
base
;
struct
Code
*
cond
;
struct
Code
*
texpr
;
struct
Code
*
fexpr
;
};
struct
Thunk
*
exec
(
Code
*
expr
,
int
frame_ptr
,
Thunk
*
target
);
struct
Thunk
*
exec
(
Code
*
expr
,
int
frame_ptr
,
Thunk
*
target
,
bool
force
);
#endif // __CODE_H
\ No newline at end of file
interpreter/desc.c
View file @
6ca85fbb
...
...
@@ -19,54 +19,47 @@ const int khStrPtr = 33;
KHASH_MAP_INIT_STR
(
khStrPtr
,
Desc
*
)
// setup khash to handle string key with an arbitrary pointer payload
// create a hashtable
khash_t
(
khStrPtr
)
*
funHash
=
kh_init
(
khStrPtr
);
khash_t
(
khStrPtr
)
*
funHash
=
kh_init
(
khStrPtr
);
void
add_desc
(
char
*
fn
,
Desc
*
desc
)
{
khiter_t
k
;
// used by the macros
kh_set
(
khStrPtr
,
funHash
,
fn
,
desc
);
void
add_desc
(
char
*
fn
,
Desc
*
desc
)
{
khiter_t
k
;
// used by the macros
kh_set
(
khStrPtr
,
funHash
,
fn
,
desc
);
}
Desc
*
find_desc
(
char
*
fn
)
{
khiter_t
k
;
// used by the macros
return
kh_get_val
(
khStrPtr
,
funHash
,
fn
);
Desc
*
find_desc
(
char
*
fn
)
{
khiter_t
k
;
// used by the macros
return
kh_get_val
(
khStrPtr
,
funHash
,
fn
);
}
Desc
*
get_slice
(
Desc
*
f
,
int
nrargs
)
{
return
&
(((
SliceEntry
*
)
f
)[
-
(
f
->
arity
-
nrargs
)].
base
);
Desc
*
get_slice
(
Desc
*
f
,
int
nrargs
)
{
return
&
(((
SliceEntry
*
)
f
)[
-
(
f
->
arity
-
nrargs
)].
base
);
}
FunEntry
*
alloc_prim
(
char
*
name
)
{
int
len
=
strlen
(
name
);
FunEntry
*
entry
=
(
FunEntry
*
)
alloc_desc
(
sizeof
(
FunEntry
)
+
len
+
1
);
entry
->
base
.
type
=
FT_BOXED_LIT
;
entry
->
base
.
arity
=
0
;
memcpy
(
entry
->
name
,
name
,
len
+
1
);
return
entry
;
FunEntry
*
alloc_prim
(
char
*
name
)
{
int
len
=
strlen
(
name
);
FunEntry
*
entry
=
(
FunEntry
*
)
alloc_desc
(
sizeof
(
FunEntry
)
+
len
+
1
);
entry
->
base
.
type
=
FT_BOXED_LIT
;
entry
->
base
.
arity
=
0
;
memcpy
(
entry
->
name
,
name
,
len
+
1
);
return
entry
;
}
void
gen_slices
(
SliceEntry
*
dest
,
Desc
*
forward_ptr
,
int
arity
)
{
for
(
int
i
=
0
;
i
<
arity
;
i
++
)
{
SliceEntry
*
slice
=
dest
+
i
;
slice
->
base
.
type
=
FT_SLICE
;
slice
->
base
.
arity
=
i
;
slice
->
forward_ptr
=
forward_ptr
;
}
void
gen_slices
(
SliceEntry
*
dest
,
Desc
*
forward_ptr
,
int
arity
)
{
for
(
int
i
=
0
;
i
<
arity
;
i
++
)
{
SliceEntry
*
slice
=
dest
+
i
;
slice
->
base
.
type
=
FT_SLICE
;
slice
->
base
.
arity
=
i
;
slice
->
forward_ptr
=
forward_ptr
;
}
}
void
init_desc
()
{
__INT__
=
alloc_prim
(
"INT"
);
__BOOL__
=
alloc_prim
(
"BOOL"
);
__CHAR__
=
alloc_prim
(
"CHAR"
);
__REAL__
=
alloc_prim
(
"REAL"
);
__STRING__
=
alloc_prim
(
"STRING"
);
__ARRAY__
=
alloc_prim
(
"ARRAY"
);
void
init_desc
()
{
__INT__
=
alloc_prim
(
"INT"
);
__BOOL__
=
alloc_prim
(
"BOOL"
);
__CHAR__
=
alloc_prim
(
"CHAR"
);
__REAL__
=
alloc_prim
(
"REAL"
);
__STRING__
=
alloc_prim
(
"STRING"
);
__ARRAY__
=
alloc_prim
(
"ARRAY"
);
}
struct
FunEntry
*
__INT__
;
...
...
interpreter/desc.h
View file @
6ca85fbb
...
...
@@ -15,64 +15,58 @@
// LIMITATION: maximum 32 arguments
struct
Desc
{
unsigned
int
type
:
3
;
unsigned
int
arity
:
8
;
struct
Desc
{
unsigned
int
type
:
3
;
unsigned
int
arity
:
8
;
};
struct
FunEntry
{
struct
Desc
base
;
int
strictness
;
union
{
char
*
parseCont
;
struct
Code
*
body
;
};
char
name
[];
struct
FunEntry
{
struct
Desc
base
;
int
strictness
;
union
{
char
*
parseCont
;
struct
Code
*
body
;
};
char
name
[];
};
// an array of these is just before an ADTEntry/FunEntry (as many as arity)
struct
SliceEntry
{
struct
Desc
base
;
Desc
*
forward_ptr
;
// FunEntry or ADTEntry
struct
SliceEntry
{
struct
Desc
base
;
Desc
*
forward_ptr
;
// FunEntry or ADTEntry
};
struct
ADTEntry
{
struct
Desc
base
;
int
strictness
;
char
name
[];
struct
ADTEntry
{
struct
Desc
base
;
int
strictness
;
char
name
[];
};
struct
CAFEntry
{
struct
Desc
base
;
union
{
char
*
parseCont
;
Code
*
body
;
Thunk
*
value
;
};