Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
cduce
cduce
Commits
e424ca5b
Commit
e424ca5b
authored
Mar 25, 2014
by
Julien Lopez
Browse files
[TESTS][EVAL] Parser is now in Camlp4
parent
1854c887
Changes
9
Hide whitespace changes
Inline
Side-by-side
tests/eval/GRAMMAR
View file @
e424ca5b
(* TODO: Update this grammar if needed.
Formaly add comments.
Formaly add comments.
*)
expr = id
| integer
| expr expr
| abstr
| "(" expr "," expr ")"
| "match" expr "with" "|" expr ["&" type_id] "->" expr branches
abstr = "let" ["fun"] id "=" expr
| "let" ["fun"] "_" "=" expr
abstr = "fun" id params "=" expr
params = (* empty *)
| id params
branches = (* empty *)
| "|" expr ["&" type_id] "->" expr branches
id = [A-Za-z][A-Za-z0-9]*
id = [A-Za-z_][A-Za-z0-9-_]*
integer = [0-9]+
tests/eval/Makefile
View file @
e424ca5b
OCAMLC
?=
ocaml
c
COMPILER
?=
ocaml
build
ROOTDIR
?=
../..
SRCDIR
?=
src
EXTDIR
?=
$(SRCDIR)
/externals
INCDIR
?=
-I
$(SRCDIR)
-I
$(EXTDIR)
FILES
=
lexer.ml parser.ml
SRCFILES
=
$
(
FILES:%
=
$(SRCDIR)
/%
)
$(SRCDIR)
/main.ml
OBJSRCFILES
=
$(SRCFILES:%.ml=%.cmo)
INCFILES
=
$
(
FILES:%
=
$(SRCDIR)
/%i
)
OBJINCFILES
=
$(INCFILES:%.mli=%.cmi)
# TODO: Improve this, we have to add twice an external file in this Makefile
INEXTFILES
=
misc/custom.ml misc/encodings.ml types/ident.ml
\
compile/lambda.mli compile/lambda.ml misc/ns.ml misc/ns.mli misc/upool.ml
\
misc/upool.mli types/sortedList.ml types/sortedList.mli types/compunit.ml
\
types/compunit.mli types/types.mli types/types.ml
INEXTSRCFILES
=
custom.ml encodings.ml upool.mli upool.ml ns.mli ns.ml
\
sortedList.mli sortedList.ml ident.ml compunit.mli compunit.ml types.mli
\
types.ml lambda.mli lambda.ml
EXTFILES
=
$
(
INEXTFILES:%
=
$(ROOTDIR)
/%
)
EXTSRCFILES
=
$
(
INEXTSRCFILES:%
=
$(EXTDIR)
/%
)
TMPEXTOBJFILES
=
$(EXTSRCFILES:%.ml=%.cmo)
EXTOBJFILES
=
$(TMPEXTOBJFILES:%.mli=%.cmi)
OTHERFILES
=
str.cma
RM
?=
rm
-f
OUT
?=
lambdaparser
OBJFILES
=
$(OBJSRCFILES)
$(OBJINCFILES)
$(EXTOBJFILES)
OUT
?=
lambda.native
.PHONY
:
clean check test
all
:
_import
$(EXTOBJFILES) $(OBJINCFILES) $(OBJSRCFILES)
$(
OCAMLC)
$(INCDIR)
-o
$(OUT)
$(OTHERFILES)
$(EXTOBJFILES)
$(OBJSRCFILES
)
all
:
_import
$(
COMPILER)
-use-ocamlfind
$(OUT
)
_import
:
@
echo
-n
"Copying external files..."
...
...
@@ -42,16 +25,11 @@ _import:
@
echo
"done"
clean
:
$(RM)
$(OBJFILES)
$(EXTSRCFILES)
$(EXTINCFILES)
$(SRCDIR)
/main.cmi
$(OUT)
$(RM)
$(OUT)
$(RM)
-r
_build
test
$(EXTDIR)
=
"src"
||
test
$(EXTDIR)
=
"."
||
$(RM)
-r
$(EXTDIR)
check
:
test
test
:
all
tests/test.sh
%.cmo
:
%.ml
$(OCAMLC)
-c
$(INCDIR)
-o
$@
$<
%.cmi
:
%.mli
$(OCAMLC)
-c
$(INCDIR)
-o
$@
$<
tests/eval/_tags
0 → 100644
View file @
e424ca5b
<src>: include
<src/lambda*>: pp(camlp4orf.opt), package(camlp4.lib)
tests/eval/src/lambda.ml
0 → 100644
View file @
e424ca5b
open
Printf
type
expr
=
|
Apply
of
expr
*
expr
|
Abstract
of
string
*
string
list
*
expr
|
Var
of
string
|
Int
of
int
|
Pair
of
expr
*
expr
|
Match
of
expr
*
(
expr
*
string
option
*
expr
)
list
;;
module
ExprParser
=
struct
open
Camlp4
.
PreCast
let
exp_eoi
=
Gram
.
Entry
.
mk
"exp_eoi"
EXTEND
Gram
GLOBAL
:
exp_eoi
;
exp_eoi
:
[[
e
=
expression
;
`EOI
->
e
]];
expression
:
[
"abstr"
RIGHTA
[
"fun"
;
x
=
LIDENT
;
p
=
LIST0
param
;
"->"
;
e
=
expression
->
Abstract
(
x
,
p
,
e
)
|
"match"
;
e1
=
expression
;
"with"
;
b
=
LIST1
branch
->
Match
(
e1
,
b
)
]
|
"pair"
LEFTA
[
e1
=
expression
;
","
;
e2
=
expression
->
Pair
(
e1
,
e2
)
|
e1
=
expression
;
"."
;
e2
=
expression
->
Apply
(
e1
,
e2
)
]
|
"paren"
[
"("
;
e
=
expression
;
")"
->
e
]
|
"var"
[
x
=
LIDENT
->
Var
(
x
)
]
|
"int"
[
x
=
INT
->
Int
(
int_of_string
x
)
]
];
param
:
[[
p
=
LIDENT
->
p
]];
branch
:
[
"branches"
LEFTA
[
"|"
;
t
=
expression
;
"->"
;
e
=
expression
->
(
t
,
None
,
e
)
|
"|"
;
t
=
expression
;
"&"
;
x
=
LIDENT
;
"->"
;
e
=
expression
->
(
t
,
Some
x
,
e
)
]
];
END
;;
let
of_string
s
=
Gram
.
parse_string
exp_eoi
(
Loc
.
mk
"<string>"
)
s
let
os
=
of_string
end
;;
exception
InvalidBranches
;;
let
rec
print_expr
expr
=
match
expr
with
|
Apply
(
e1
,
e2
)
->
printf
"Apply("
;
print_expr
e1
;
printf
", "
;
print_expr
e2
;
printf
")"
|
Abstract
(
fname
,
params
,
e
)
->
printf
"Abstract(%s"
fname
;
print_params
params
;
printf
", "
;
print_expr
e
;
printf
")"
|
Var
(
vname
)
->
printf
"Var(%s)"
vname
|
Int
(
i
)
->
printf
"Int(%d)"
i
|
Pair
(
e1
,
e2
)
->
printf
"Pair("
;
print_expr
e1
;
printf
", "
;
print_expr
e2
;
printf
")"
|
Match
(
e
,
b
)
->
printf
"Match("
;
print_expr
e
;
printf
", "
;
print_branches
b
;
printf
")"
and
print_params
params
=
match
params
with
|
p
::
rest
->
printf
" %s"
p
;
print_params
rest
|
[]
->
()
and
print_branches
b
=
match
b
with
|
(
br
,
None
,
exp
)
::
rest
->
printf
"("
;
print_expr
br
;
printf
", "
;
print_expr
exp
;
printf
")"
;
print_branches
rest
|
(
br
,
Some
x
,
exp
)
::
rest
->
printf
"("
;
print_expr
br
;
printf
" & %s, "
x
;
print_expr
exp
;
printf
")"
;
print_branches
rest
|
[]
->
()
;;
let
rec
expr_to_string
expr
=
match
expr
with
|
Apply
(
e1
,
e2
)
->
(
expr_to_string
e1
)
^
" . "
^
(
expr_to_string
e2
)
|
Abstract
(
fname
,
params
,
e
)
->
"fun "
^
fname
^
(
params_to_string
params
)
^
" -> "
^
(
expr_to_string
e
)
|
Var
(
vname
)
->
vname
|
Int
(
i
)
->
string_of_int
i
|
Pair
(
e1
,
e2
)
->
"("
^
(
expr_to_string
e1
)
^
", "
^
(
expr_to_string
e2
)
^
")"
|
Match
(
e
,
b
)
->
"match "
^
(
expr_to_string
e
)
^
" with"
^
(
branches_to_string
b
)
and
params_to_string
params
=
match
params
with
|
p
::
rest
->
" "
^
p
^
(
params_to_string
rest
)
|
[]
->
""
and
branches_to_string
b
=
match
b
with
|
(
br
,
None
,
exp
)
::
rest
->
"
\n
| "
^
(
expr_to_string
br
)
^
" -> "
^
(
expr_to_string
exp
)
^
(
branches_to_string
rest
)
|
(
br
,
Some
x
,
exp
)
::
rest
->
"
\n
| "
^
(
expr_to_string
br
)
^
" & "
^
x
^
" -> "
^
(
expr_to_string
exp
)
^
(
branches_to_string
rest
)
|
[]
->
""
;;
let
str
=
"fun firsts x y -> match x,y with
| (a,_),(b,_) -> a,b (* This (* is (* a nested *) *) comment *)
| _ -> x (* That doesn't make any sense *)"
in
let
expr
=
ExprParser
.
of_string
str
in
printf
"Original: %s
\n
Expr: "
str
;
print_expr
expr
;
printf
"
\n
Result: %s
\n
"
(
expr_to_string
expr
)
tests/eval/src/lexer.ml
deleted
100644 → 0
View file @
1854c887
open
Printf
open
Str
type
token
=
|
Keyword
of
string
|
Operator
of
string
|
Id
of
string
|
Int
of
int
module
StrMap
=
Map
.
Make
(
String
);;
let
rec
gen_keywords
keywords
list
=
match
list
with
|
el
::
rest
->
gen_keywords
(
StrMap
.
add
el
(
Keyword
el
)
keywords
)
rest
|
[]
->
keywords
let
rec
gen_ops
ops
list
=
match
list
with
|
el
::
rest
->
gen_ops
(
StrMap
.
add
el
(
Operator
el
)
ops
)
rest
|
[]
->
ops
let
keywords
=
gen_keywords
(
StrMap
.
add
"let"
(
Keyword
"let"
)
StrMap
.
empty
)
[
"fun"
;
"match"
;
"with"
;
"_"
]
let
ops
=
gen_ops
(
StrMap
.
add
"="
(
Operator
"="
)
StrMap
.
empty
)
[
"("
;
")"
;
","
;
"|"
;
"&"
;
"->"
;
";"
]
(* Regexp to find an operator in a string *)
let
strops
=
"[=(),|&;]
\\
|->"
let
rec
print_expr
expr
=
match
expr
with
|
Keyword
str
::
rest
->
printf
"Keyword: %s
\n
"
str
;
print_expr
rest
|
Operator
str
::
rest
->
printf
"Operator: %s
\n
"
str
;
print_expr
rest
|
Id
str
::
rest
->
printf
"Id: %s
\n
"
str
;
print_expr
rest
|
Int
i
::
rest
->
printf
"Int: %d
\n
"
i
;
print_expr
rest
|
[]
->
printf
""
(* TODO: Add support for comments *)
let
lex
str
=
let
rec
_lex_noblanks
list
res
=
match
list
with
|
Delim
d
::
rest
->
_lex_noblanks
rest
(
res
@
[
Operator
d
])
|
Text
t
::
rest
->
(
try
_lex_noblanks
rest
(
res
@
[
Int
(
int_of_string
t
)]);
with
Failure
_
->
_lex_noblanks
rest
(
res
@
[
Id
t
]))
|
[]
->
res
in
let
rec
_lex
list
res
=
match
list
with
|
el
::
rest
->
(
try
let
k
=
StrMap
.
find
el
keywords
in
_lex
rest
(
res
@
[
k
])
with
Not_found
->
try
let
o
=
StrMap
.
find
el
ops
in
_lex
rest
(
res
@
[
o
])
with
Not_found
->
_lex
rest
(
res
@
(
_lex_noblanks
(
Str
.
full_split
(
Str
.
regexp
strops
)
el
)
[]
))
)
|
[]
->
res
in
_lex
(
Str
.
split
(
Str
.
regexp
"[
\t\n
]+"
)
str
)
[]
tests/eval/src/lexer.mli
deleted
100644 → 0
View file @
1854c887
type
token
=
|
Keyword
of
string
|
Operator
of
string
|
Id
of
string
|
Int
of
int
val
lex
:
string
->
token
list
val
print_expr
:
token
list
->
unit
tests/eval/src/main.ml
deleted
100644 → 0
View file @
1854c887
open
Printf
let
load_file
f
=
let
ic
=
open_in
f
in
let
n
=
in_channel_length
ic
in
let
s
=
String
.
create
n
in
really_input
ic
s
0
n
;
close_in
ic
;
s
let
ignore
a
=
printf
"Ignoring...
\n
"
let
_
=
if
Array
.
length
Sys
.
argv
-
1
<>
0
then
let
str
=
load_file
Sys
.
argv
.
(
1
)
in
let
tokens
=
Lexer
.
lex
str
in
let
env
=
[
||
]
in
let
locals
=
[
||
]
in
Lexer
.
print_expr
tokens
;
Parser
.
parse_expr
env
locals
tokens
tests/eval/src/parser.ml
deleted
100644 → 0
View file @
1854c887
open
Printf
open
Lexer
let
rec
parse_expr
env
locals
expr
=
match
expr
with
|
Keyword
str
::
rest
->
printf
"%s"
(
"Keyword: "
^
str
^
"
\n
"
);
parse_expr
env
locals
rest
|
Operator
str
::
rest
->
printf
"%s"
(
"Operator: "
^
str
^
"
\n
"
);
parse_expr
env
locals
rest
|
Id
str
::
rest
->
printf
"%s"
(
"Id: "
^
str
^
"
\n
"
);
parse_expr
env
locals
rest
|
Int
i
::
rest
->
printf
"%s%d%s"
"Int: "
i
"
\n
"
;
parse_expr
env
locals
rest
|
[]
->
printf
""
tests/eval/src/parser.mli
deleted
100644 → 0
View file @
1854c887
val
parse_expr
:
Lambda
.
Env
ref
array
->
Lambda
.
Local
ref
array
->
Lexer
.
token
list
->
Lambda
.
expr
list
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