Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Armillon Damien
infosec-ecomp
Commits
bb778ca1
Commit
bb778ca1
authored
Mar 22, 2021
by
Armillon Damien
Browse files
use builtins lib
parent
71894415
Changes
7
Hide whitespace changes
Inline
Side-by-side
Makefile
View file @
bb778ca1
...
...
@@ -28,4 +28,4 @@ test: main.native
make
-C
tests
testFun
:
main.native
make
-C
tests
DIR
=
custom/
*
.e
\ No newline at end of file
make
-C
tests
DIR
=
funcall/
*
.e
\ No newline at end of file
expr_grammar_action.g
View file @
bb778ca1
tokens SYM_EOF SYM_IDENTIFIER<string> SYM_INTEGER<int> SYM_PLUS SYM_MINUS SYM_ASTERISK SYM_DIV SYM_MOD
tokens SYM_LPARENTHESIS SYM_RPARENTHESIS SYM_LBRACE SYM_RBRACE
tokens SYM_ASSIGN SYM_SEMICOLON SYM_RETURN SYM_IF SYM_WHILE SYM_ELSE SYM_COMMA
SYM_PRINT
tokens SYM_ASSIGN SYM_SEMICOLON SYM_RETURN SYM_IF SYM_WHILE SYM_ELSE SYM_COMMA
tokens SYM_EQUALITY SYM_NOTEQ SYM_LT SYM_LEQ SYM_GT SYM_GEQ
non-terminals S INSTR INSTRS LINSTRS ELSE EXPR FACTOR
non-terminals LPARAMS REST_PARAMS
...
...
@@ -51,7 +51,6 @@ INSTR -> SYM_IDENTIFIER IN_INSTR {$2 $1}
INSTR -> SYM_IF SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS BLOC ELSE {Node(Tif, $3::$5::$6)}
INSTR -> SYM_WHILE SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS BLOC {Node(Twhile, [$3;$5])}
INSTR -> SYM_RETURN EXPR SYM_SEMICOLON {Node(Treturn, [$2])}
INSTR -> SYM_PRINT SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS SYM_SEMICOLON {Node(Tprint, [$3])}
ELSE -> SYM_ELSE BLOC {[$2]}
ELSE -> {[]}
EXPR -> EQ_EXPR EQ_EXPRS {resolve_associativity $1 $2}
...
...
src/cfg_run.ml
View file @
bb778ca1
...
...
@@ -25,16 +25,23 @@ let rec eval_cfgexpr oc cp st (e: expr) : (int * int Prog.state) res =
|
None
->
Error
(
Printf
.
sprintf
"Unknown variable %s
\n
"
s
)
end
|
Ecall
(
name
,
el
)
->
let
*
f
=
find_function
cp
name
in
let
*
(
params
,
st
)
=
List
.
fold_left
(
fun
acc
expr
->
let
*
(
expr_list
,
st
)
=
acc
in
let
*
(
new_expr
,
st
)
=
eval_cfgexpr
oc
cp
st
expr
in
OK
(
expr_list
@
[
new_expr
]
,
st
)
)
(
OK
([]
,
st
))
el
in
let
*
(
i
,
st
)
=
eval_cfgfun
cp
oc
st
name
f
params
in
match
i
with
|
None
->
Error
(
Printf
.
sprintf
"Error while runing %s"
name
)
|
Some
(
i
)
->
OK
(
i
,
st
)
match
find_function
cp
name
with
|
OK
f
->
let
*
(
i
,
st
)
=
eval_cfgfun
cp
oc
st
name
f
params
in
(
match
i
with
|
None
->
Error
(
Printf
.
sprintf
"Error while runing %s"
name
)
|
Some
(
i
)
->
OK
(
i
,
st
))
|
Error
_
->
let
*
ret
=
do_builtin
oc
st
.
mem
name
params
in
(
match
ret
with
|
Some
n
->
OK
(
n
,
st
)
|
None
->
OK
(
0
,
st
))
and
eval_cfginstr
cp
oc
st
ht
(
n
:
int
)
:
(
int
*
int
state
)
res
=
match
Hashtbl
.
find_option
ht
n
with
...
...
@@ -57,17 +64,32 @@ and eval_cfginstr cp oc st ht (n: int): (int * int state) res =
let
*
(
e
,
st
)
=
eval_cfgexpr
oc
cp
st
e
in
Format
.
fprintf
oc
"%d
\n
"
e
;
eval_cfginstr
cp
oc
st
ht
succ
|
Ccall
(
name
,
el
,
s
)
->
let
*
f
=
find_function
cp
name
in
|
Ccall
(
name
,
el
,
succ
)
->
let
*
(
params
,
st
)
=
List
.
fold_left
(
fun
acc
expr
->
let
*
(
expr_list
,
st
)
=
acc
in
let
*
(
new_expr
,
st
)
=
eval_cfgexpr
oc
cp
st
expr
in
OK
(
expr_list
@
[
new_expr
]
,
st
)
)
(
OK
([]
,
st
))
el
in
let
*
(
i
,
st
)
=
eval_cfgfun
cp
oc
st
name
f
params
in
match
i
with
|
None
->
Error
(
Printf
.
sprintf
"Error while runing %s"
name
)
|
Some
(
i
)
->
OK
(
i
,
st
)
match
find_function
cp
name
with
|
OK
f
->
let
*
f
=
find_function
cp
name
in
let
*
(
i
,
st
)
=
eval_cfgfun
cp
oc
st
name
f
params
in
(
match
i
with
|
None
->
Error
(
Printf
.
sprintf
"Error while runing %s"
name
)
|
Some
(
i
)
->
OK
(
i
,
st
))
|
Error
_
->
match
find_function
cp
name
with
|
OK
f
->
let
*
(
res
,
st
)
=
eval_cfgfun
cp
oc
st
name
f
params
in
(
match
res
with
|
Some
(
n
)
->
OK
(
n
,
st
)
|
None
->
Error
(
Format
.
sprintf
"Error with function %s"
name
))
|
Error
_
->
let
*
ret
=
do_builtin
oc
st
.
mem
name
params
in
(
match
ret
with
|
Some
n
->
OK
(
n
,
st
)
|
None
->
eval_cfginstr
cp
oc
st
ht
succ
)
...
...
src/elang_gen.ml
View file @
bb778ca1
...
...
@@ -91,9 +91,7 @@ let rec make_einstr_of_ast (a: tree) : instr res =
|
_
->
[]
)
in
list_map_res
(
fun
e
->
make_eexpr_of_ast
e
)
args_list
>>=
fun
args_expr
->
(
match
name
with
|
"print"
when
List
.
length
args_expr
=
1
->
OK
(
Iprint
(
List
.
hd
args_expr
))
|
_
->
OK
(
Icall
(
name
,
args_expr
)))
OK
(
Icall
(
name
,
args_expr
))
|
Node
(
t
,
e1
::
i1
::
i2
)
when
t
=
Tif
->
make_eexpr_of_ast
e1
>>=
fun
expr1
->
...
...
src/elang_run.ml
View file @
bb778ca1
...
...
@@ -53,12 +53,18 @@ let rec eval_eexpr oc (ep: eprog) st (e : expr) : (int * int Prog.state) res =
let
*
(
expr_l
,
st
)
=
acc
in
let
*
(
arg_expr
,
st
)
=
eval_eexpr
oc
ep
st
expr
in
OK
(
expr_l
@
[
arg_expr
]
,
st
)
)
(
OK
([]
,
st
))
expr_list
in
let
*
f
=
find_function
ep
name
in
let
*
(
res
,
st
)
=
eval_efun
oc
ep
st
f
name
args
in
match
res
with
|
Some
(
n
)
->
OK
(
n
,
st
)
|
None
->
Error
(
Format
.
sprintf
"Error with function %s"
name
)
)
(
OK
([]
,
st
))
expr_list
in
match
find_function
ep
name
with
|
OK
f
->
let
*
(
res
,
st
)
=
eval_efun
oc
ep
st
f
name
args
in
(
match
res
with
|
Some
(
n
)
->
OK
(
n
,
st
)
|
None
->
Error
(
Format
.
sprintf
"Error with function %s"
name
))
|
Error
_
->
let
*
ret
=
do_builtin
oc
st
.
mem
name
args
in
match
ret
with
|
Some
n
->
OK
(
n
,
st
)
|
None
->
Error
(
Format
.
sprintf
"Error: %s doesn't return anything"
name
)
(* [eval_einstr oc st ins] évalue l'instrution [ins] en partant de l'état [st].
...
...
@@ -119,8 +125,11 @@ and eval_einstr oc (ep: eprog) (st: int state) (ins: instr) :
let
*
(
arg_expr
,
st
)
=
eval_eexpr
oc
ep
st
expr
in
OK
(
expr_l
@
[
arg_expr
]
,
st
)
)
(
OK
([]
,
st
))
expr_list
in
let
*
f
=
find_function
ep
name
in
eval_efun
oc
ep
st
f
name
args
match
find_function
ep
name
with
|
OK
f
->
eval_efun
oc
ep
st
f
name
args
|
Error
_
->
let
*
ret
=
do_builtin
oc
st
.
mem
name
args
in
OK
(
ret
,
st
)
(* [eval_efun oc st f fname vargs] évalue la fonction [f] (dont le nom est
...
...
src/linear_run.ml
View file @
bb778ca1
...
...
@@ -61,14 +61,18 @@ let rec exec_linear_instr oc lp fname f st (i: rtl_instr) =
end
|
Rlabel
n
->
OK
(
None
,
st
)
|
Rcall
(
rs
,
name
,
regl
)
->
let
*
f'
=
find_function
lp
name
in
let
params
=
List
.
map
(
Hashtbl
.
find
st
.
regs
)
regl
in
let
*
(
v
,
st
)
=
exec_linear_fun
oc
lp
st
name
f'
params
in
if
Option
.
is_some
rs
then
match
v
with
|
Some
v
->
let
rs
=
Option
.
get
rs
in
Hashtbl
.
replace
st
.
regs
rs
v
;
OK
(
None
,
st
)
|
None
->
Error
(
Printf
.
sprintf
"function %s return nothing can't assign in (%s)"
name
(
print_reg
(
Option
.
get
rs
)))
else
OK
(
None
,
st
)
match
find_function
lp
name
with
|
OK
f'
->
let
*
(
v
,
st
)
=
exec_linear_fun
oc
lp
st
name
f'
params
in
if
Option
.
is_some
rs
then
match
v
with
|
Some
v
->
let
rs
=
Option
.
get
rs
in
Hashtbl
.
replace
st
.
regs
rs
v
;
OK
(
None
,
st
)
|
None
->
Error
(
Printf
.
sprintf
"function %s return nothing can't assign in (%s)"
name
(
print_reg
(
Option
.
get
rs
)))
else
OK
(
None
,
st
)
|
Error
_
->
let
*
ret
=
do_builtin
oc
st
.
mem
name
params
in
OK
(
ret
,
st
)
and
exec_linear_instr_at
oc
lp
fname
({
linearfunbody
;
}
as
f
)
st
i
=
let
l
=
List
.
drop_while
(
fun
x
->
x
<>
Rlabel
i
)
linearfunbody
in
...
...
src/rtl_run.ml
View file @
bb778ca1
...
...
@@ -78,14 +78,19 @@ let rec exec_rtl_instr oc rp rtlfunname f st (i: rtl_instr) =
end
|
Rlabel
n
->
OK
(
None
,
st
)
|
Rcall
(
rs
,
name
,
regl
)
->
let
*
f'
=
find_function
rp
name
in
let
params
=
List
.
map
(
Hashtbl
.
find
st
.
regs
)
regl
in
let
*
(
v
,
st
)
=
exec_rtl_fun
oc
rp
st
name
f'
params
in
if
Option
.
is_some
rs
then
match
v
with
|
Some
v
->
let
rs
=
Option
.
get
rs
in
Hashtbl
.
replace
st
.
regs
rs
v
;
OK
(
None
,
st
)
|
None
->
Error
(
Printf
.
sprintf
"function %s return nothing can't assign in (%s)"
name
(
print_reg
(
Option
.
get
rs
)))
else
OK
(
None
,
st
)
match
find_function
rp
name
with
|
OK
f'
->
let
*
(
v
,
st
)
=
exec_rtl_fun
oc
rp
st
name
f'
params
in
if
Option
.
is_some
rs
then
match
v
with
|
Some
v
->
let
rs
=
Option
.
get
rs
in
Hashtbl
.
replace
st
.
regs
rs
v
;
OK
(
None
,
st
)
|
None
->
Error
(
Printf
.
sprintf
"function %s return nothing can't assign in (%s)"
name
(
print_reg
(
Option
.
get
rs
)))
else
OK
(
None
,
st
)
|
Error
_
->
let
*
ret
=
do_builtin
oc
st
.
mem
name
params
in
OK
(
ret
,
st
)
and
exec_rtl_instr_at
oc
rp
rtlfunname
({
rtlfunbody
;
}
as
f
:
rtl_fun
)
st
i
=
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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