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
8367c11b
Commit
8367c11b
authored
Apr 02, 2014
by
Julien Lopez
Browse files
[TESTS][LAMBDA] Split compute and parse (needed to create the environment)
parent
dcbf304d
Changes
7
Hide whitespace changes
Inline
Side-by-side
tests/lambda/Makefile
View file @
8367c11b
...
...
@@ -15,14 +15,15 @@ INEXTFILES = misc/custom.ml misc/encodings.ml misc/upool.ml misc/ns.ml\
types/externals.mli types/externals.ml typing/typer.ml
\
runtime/run_dispatch.ml runtime/explain.ml schema/schema_pcre.ml
\
schema/schema_xml.mli schema/schema_xml.ml schema/schema_common.mli
\
schema/schema_common.ml runtime/eval.mli runtime/eval.ml compile/compile.ml
\
types/compunit.mli types/compunit.ml types/var.ml types/boolVar.ml
\
misc/imap.ml types/atoms.ml types/intervals.ml types/chars.mli types/chars.ml
\
misc/bool.mli misc/bool.ml types/types.mli misc/stats.mli misc/stats.ml
\
types/normal.mli types/normal.ml misc/pretty.mli misc/pretty.ml
\
types/types.ml compile/auto_pat.mli runtime/value.mli runtime/value.ml
\
schema/schema_types.mli schema/schema_validator.mli schema/schema_builtin.mli
\
schema/schema_builtin.ml schema/schema_validator.ml compile/lambda.ml
schema/schema_common.ml runtime/eval.mli runtime/eval.ml compile/compile.mli
\
compile/compile.ml types/compunit.mli types/compunit.ml types/var.ml
\
types/boolVar.ml misc/imap.ml types/atoms.ml types/intervals.ml
\
types/chars.mli types/chars.ml misc/bool.mli misc/bool.ml types/types.mli
\
misc/stats.mli misc/stats.ml types/normal.mli types/normal.ml misc/pretty.mli
\
misc/pretty.ml types/types.ml compile/auto_pat.mli runtime/value.mli
\
runtime/value.ml schema/schema_types.mli schema/schema_validator.mli
\
schema/schema_builtin.mli schema/schema_builtin.ml schema/schema_validator.ml
\
compile/lambda.ml
EXTFILES
=
$
(
INEXTFILES:%
=
$(ROOTDIR)
/%
)
RM
?=
rm
-f
...
...
tests/lambda/_tags
View file @
8367c11b
<src>: include
<src/parse*>: pp(camlp4orf.opt), package(camlp4.lib, unix, netsys, str)
<src/main*>: pp(camlp4orf.opt), package(camlp4.lib, unix, netsys, str)
<src/parse*>: pp(camlp4orf.opt), package(camlp4.lib)
<src/compute*>: pp(camlp4orf.opt), package(camlp4.lib, unix, netsys, str)
<src/main*>: pp(camlp4orf.opt), package(camlp4.lib, unix, netsys, str)
<src/externals>: include
<src/externals/schema_*>: package(pcre, netcgi2
, unix, netsys, str
)
<src/externals/schema_*>: package(pcre, netcgi2)
<src/externals/cduce_loc*>: package(ulex), syntax(camlp4o)
tests/lambda/src/compute.ml
0 → 100644
View file @
8367c11b
open
Parse
open
Typed
open
Camlp4
.
PreCast
let
rec
to_typed
expr
=
let
env
=
Compile
.
empty_toplevel
in
match
expr
with
|
Parse
.
Apply
(
loc
,
e1
,
e2
)
->
let
loc
=
`File
(
Loc
.
file_name
loc
)
,
Loc
.
start_off
loc
-
Loc
.
start_bol
loc
,
Loc
.
stop_off
loc
-
Loc
.
start_bol
loc
in
env
,
{
exp_loc
=
loc
;
exp_typ
=
Types
.
any
;
exp_descr
=
Apply
(
snd
(
to_typed
e1
)
,
snd
(
to_typed
e2
))
}
|
Abstr
(
loc
,
fun_name
,
params
,
return_type
,
body
)
->
env
,
parse_abstr
loc
fun_name
params
return_type
body
|
Match
(
loc
,
e
,
b
)
->
let
loc
=
`File
(
Loc
.
file_name
loc
)
,
Loc
.
start_off
loc
-
Loc
.
start_bol
loc
,
Loc
.
stop_off
loc
-
Loc
.
start_bol
loc
in
let
b
=
parse_branches
b
[]
in
let
brs
=
{
br_typ
=
Types
.
any
;
br_accept
=
Types
.
any
;
br_branches
=
b
}
in
env
,
{
exp_loc
=
loc
;
exp_typ
=
Types
.
any
;
exp_descr
=
Match
(
snd
(
to_typed
e
)
,
brs
)
}
|
Pair
(
loc
,
e1
,
e2
)
->
let
loc
=
`File
(
Loc
.
file_name
loc
)
,
Loc
.
start_off
loc
-
Loc
.
start_bol
loc
,
Loc
.
stop_off
loc
-
Loc
.
start_bol
loc
in
env
,
{
exp_loc
=
loc
;
exp_typ
=
Types
.
any
;
exp_descr
=
Pair
(
snd
(
to_typed
e1
)
,
snd
(
to_typed
e2
))
}
|
Var
(
loc
,
vname
)
->
let
loc
=
`File
(
Loc
.
file_name
loc
)
,
Loc
.
start_off
loc
-
Loc
.
start_bol
loc
,
Loc
.
stop_off
loc
-
Loc
.
start_bol
loc
in
env
,
{
exp_loc
=
loc
;
exp_typ
=
Types
.
any
;
exp_descr
=
Var
(
0
,
vname
)
}
|
Int
(
loc
,
i
)
->
let
loc
=
`File
(
Loc
.
file_name
loc
)
,
Loc
.
start_off
loc
-
Loc
.
start_bol
loc
,
Loc
.
stop_off
loc
-
Loc
.
start_bol
loc
in
let
i
=
Big_int
.
big_int_of_int
i
in
env
,
{
exp_loc
=
loc
;
exp_typ
=
Types
.
any
;
exp_descr
=
Cst
(
Types
.
Integer
i
)
}
|
String
(
loc
,
s
)
->
let
loc
=
`File
(
Loc
.
file_name
loc
)
,
Loc
.
start_off
loc
-
Loc
.
start_bol
loc
,
Loc
.
stop_off
loc
-
Loc
.
start_bol
loc
in
let
s
=
Types
.
String
(
0
,
(
String
.
length
s
)
-
1
,
s
,
Types
.
Integer
(
Big_int
.
big_int_of_int
0
))
in
env
,
{
exp_loc
=
loc
;
exp_typ
=
Types
.
any
;
exp_descr
=
Cst
s
}
and
parse_abstr
loc
fun_name
params
return_type
body
=
let
loc
=
`File
(
Loc
.
file_name
loc
)
,
Loc
.
start_off
loc
-
Loc
.
start_bol
loc
,
Loc
.
stop_off
loc
-
Loc
.
start_bol
loc
in
let
node
=
Patterns
.
make
[]
in
let
brloc
=
get_loc
body
in
let
brloc
=
`File
(
Loc
.
file_name
brloc
)
,
Loc
.
start_off
brloc
-
Loc
.
start_bol
brloc
,
Loc
.
stop_off
brloc
-
Loc
.
start_bol
brloc
in
let
br
=
{
br_loc
=
brloc
;
br_used
=
true
;
br_ghost
=
false
;
br_vars_empty
=
[]
;
br_pat
=
node
;
br_body
=
snd
(
to_typed
body
)
}
in
let
brs
=
{
br_typ
=
Types
.
any
;
br_accept
=
Types
.
any
;
br_branches
=
[
br
]
}
in
let
iface
=
parse_iface
params
[]
in
{
exp_loc
=
loc
;
exp_typ
=
Types
.
any
;
exp_descr
=
Abstraction
({
fun_name
=
Some
(
0
,
fun_name
);
fun_iface
=
iface
;
fun_body
=
brs
;
fun_typ
=
Types
.
any
;
fun_fv
=
[]
})
}
and
parse_iface
params
res
=
match
params
with
|
_
::
rest
->
parse_iface
rest
(
res
@
[
Types
.
any
,
Types
.
any
])
|
[]
->
res
and
parse_branches
brs
res
=
match
brs
with
|
(
loc
,
p
,
e
)
::
rest
->
let
loc
=
`File
(
Loc
.
file_name
loc
)
,
Loc
.
start_off
loc
-
Loc
.
start_bol
loc
,
Loc
.
stop_off
loc
-
Loc
.
start_bol
loc
in
let
node
=
Patterns
.
make
[]
in
let
b
=
{
br_loc
=
loc
;
br_used
=
true
;
br_ghost
=
false
;
br_vars_empty
=
[]
;
br_pat
=
node
;
br_body
=
snd
(
to_typed
e
)}
in
parse_branches
rest
(
res
@
[
b
])
|
[]
->
res
tests/lambda/src/compute.mli
0 → 100644
View file @
8367c11b
val
to_typed
:
Parse
.
expr
->
Compile
.
env
*
Typed
.
texpr
tests/lambda/src/main.ml
View file @
8367c11b
open
Printf
open
Parse
open
Compile
open
Value
open
Camlp4
.
PreCast
...
...
@@ -36,8 +35,8 @@ let str, file =
in
try
let
expr
=
ExprParser
.
of_string
str
file
in
let
lambda
expr
=
c
omp
ile
(
mk
None
)
expr
in
let
evalexpr
=
E
val
.
expr
lambdaexpr
100
in
let
env
,
t
expr
=
C
omp
ute
.
to_typed
expr
in
let
evalexpr
=
Compile
.
compile_e
val
_
expr
env
texpr
in
print_value
evalexpr
;
printf
"
\n
"
with
|
Loc
.
Exc_located
(
loc
,
exn
)
->
...
...
tests/lambda/src/parse.ml
View file @
8367c11b
open
Printf
open
Typed
open
Patterns
open
Camlp4
.
PreCast
type
expr
=
|
Apply
of
Loc
.
t
*
expr
*
expr
|
Abstr
of
Loc
.
t
*
fun_name
*
params
*
ptype
*
expr
|
Match
of
Loc
.
t
*
expr
*
branches
|
Pair
of
Loc
.
t
*
expr
*
expr
|
Var
of
Loc
.
t
*
string
|
Int
of
Loc
.
t
*
int
|
String
of
Loc
.
t
*
string
and
fun_name
=
string
and
params
=
(
Loc
.
t
*
string
*
ptype
)
list
and
branches
=
(
Loc
.
t
*
match_value
*
expr
)
list
and
match_value
=
|
MPair
of
Loc
.
t
*
match_value
*
match_value
|
MVar
of
Loc
.
t
*
string
*
ptype
|
MInt
of
Loc
.
t
*
int
|
MString
of
Loc
.
t
*
string
and
ptype
=
string
module
ExprParser
=
struct
let
exp_eoi
=
Gram
.
Entry
.
mk
"exp_eoi"
...
...
@@ -15,101 +31,41 @@ module ExprParser = struct
expression
:
[
"abstr"
RIGHTA
[
"fun"
;
x
=
LIDENT
;
p
=
LIST1
param
;
":"
;
t
=
UIDENT
;
"->"
;
e
=
SELF
->
let
loc
=
`File
(
Loc
.
file_name
_loc
)
,
Loc
.
start_off
_loc
-
Loc
.
start_bol
_loc
,
Loc
.
stop_off
_loc
-
Loc
.
start_bol
_loc
in
let
node
=
Patterns
.
make
[]
in
let
br
=
{
br_loc
=
e
.
exp_loc
;
br_used
=
true
;
br_ghost
=
false
;
br_vars_empty
=
[]
;
br_pat
=
node
;
br_body
=
e
}
in
let
brs
=
{
br_typ
=
Types
.
any
;
br_accept
=
Types
.
any
;
br_branches
=
[
br
]
}
in
{
exp_loc
=
loc
;
exp_typ
=
Types
.
any
;
exp_descr
=
Abstraction
({
fun_name
=
Some
(
0
,
x
);
fun_iface
=
p
;
fun_body
=
brs
;
fun_typ
=
Types
.
any
;
fun_fv
=
[]
})
}
|
"match"
;
e1
=
SELF
;
"with"
;
b
=
LIST1
branch
->
let
loc
=
`File
(
Loc
.
file_name
_loc
)
,
Loc
.
start_off
_loc
-
Loc
.
start_bol
_loc
,
Loc
.
stop_off
_loc
-
Loc
.
start_bol
_loc
in
let
brs
=
{
br_typ
=
Types
.
any
;
br_accept
=
Types
.
any
;
br_branches
=
b
}
in
{
exp_loc
=
loc
;
exp_typ
=
Types
.
any
;
exp_descr
=
Match
(
e1
,
brs
)
}
]
[
"fun"
;
x
=
LIDENT
;
p
=
LIST1
param
;
":"
;
t
=
UIDENT
;
"->"
;
e
=
SELF
->
Abstr
(
_loc
,
x
,
p
,
t
,
e
)
|
"match"
;
e
=
SELF
;
"with"
;
b
=
LIST1
branch
->
Match
(
_loc
,
e
,
b
)
]
|
"pair"
LEFTA
[
e1
=
SELF
;
","
;
e2
=
SELF
->
let
loc
=
`File
(
Loc
.
file_name
_loc
)
,
Loc
.
start_off
_loc
-
Loc
.
start_bol
_loc
,
Loc
.
stop_off
_loc
-
Loc
.
start_bol
_loc
in
{
exp_loc
=
loc
;
exp_typ
=
Types
.
any
;
exp_descr
=
Pair
(
e1
,
e2
)
}
|
e1
=
SELF
;
"."
;
e2
=
SELF
->
let
loc
=
`File
(
Loc
.
file_name
_loc
)
,
Loc
.
start_off
_loc
-
Loc
.
start_bol
_loc
,
Loc
.
stop_off
_loc
-
Loc
.
start_bol
_loc
in
{
exp_loc
=
loc
;
exp_typ
=
Types
.
any
;
exp_descr
=
Apply
(
e1
,
e2
)
}
]
[
e1
=
SELF
;
","
;
e2
=
SELF
->
Pair
(
_loc
,
e1
,
e2
)
|
e1
=
SELF
;
"."
;
e2
=
SELF
->
Apply
(
_loc
,
e1
,
e2
)
]
|
"paren"
[
"("
;
e
=
SELF
;
")"
->
e
]
|
"var"
[
x
=
LIDENT
->
let
loc
=
`File
(
Loc
.
file_name
_loc
)
,
Loc
.
start_off
_loc
-
Loc
.
start_bol
_loc
,
Loc
.
stop_off
_loc
-
Loc
.
start_bol
_loc
in
{
exp_loc
=
loc
;
exp_typ
=
Types
.
any
;
exp_descr
=
Var
(
0
,
x
)
}
]
|
"int"
[
x
=
INT
->
let
loc
=
`File
(
Loc
.
file_name
_loc
)
,
Loc
.
start_off
_loc
-
Loc
.
start_bol
_loc
,
Loc
.
stop_off
_loc
-
Loc
.
start_bol
_loc
in
let
x
=
Big_int
.
big_int_of_int
(
int_of_string
x
)
in
{
exp_loc
=
loc
;
exp_typ
=
Types
.
any
;
exp_descr
=
Cst
(
Types
.
Integer
x
)
}
]
|
"string"
[
x
=
STRING
->
let
loc
=
`File
(
Loc
.
file_name
_loc
)
,
Loc
.
start_off
_loc
-
Loc
.
start_bol
_loc
,
Loc
.
stop_off
_loc
-
Loc
.
start_bol
_loc
in
let
x
=
Types
.
String
(
0
,
(
String
.
length
x
)
-
1
,
x
,
Types
.
Integer
(
Big_int
.
big_int_of_int
0
))
in
{
exp_loc
=
loc
;
exp_typ
=
Types
.
any
;
exp_descr
=
Cst
x
}
]
|
"var"
[
x
=
LIDENT
->
Var
(
_loc
,
x
)
]
|
"int"
[
x
=
INT
->
Int
(
_loc
,
int_of_string
x
)
]
|
"string"
[
x
=
STRING
->
String
(
_loc
,
x
)
]
];
param
:
[[
p
=
LIDENT
;
":"
;
t
=
UIDENT
->
Types
.
any
,
Types
.
any
]];
param
:
[[
p
=
LIDENT
;
":"
;
t
=
UIDENT
->
_loc
,
p
,
t
]];
branch
:
[
"branch"
LEFTA
[
"|"
;
t
=
match_value
;
"->"
;
e
=
expression
->
let
loc
=
`File
(
Loc
.
file_name
_loc
)
,
Loc
.
start_off
_loc
-
Loc
.
start_bol
_loc
,
Loc
.
stop_off
_loc
-
Loc
.
start_bol
_loc
in
let
node
=
Patterns
.
make
[]
in
{
br_loc
=
loc
;
br_used
=
true
;
br_ghost
=
false
;
br_vars_empty
=
[]
;
br_pat
=
node
;
br_body
=
e
}
]
];
branch
:
[
"branch"
[
"|"
;
t
=
match_value
;
"->"
;
e
=
expression
->
_loc
,
t
,
e
]];
match_value
:
[
"pair"
LEFTA
[
e1
=
SELF
;
","
;
e2
=
SELF
->
let
loc
=
`File
(
Loc
.
file_name
_loc
)
,
Loc
.
start_off
_loc
-
Loc
.
start_bol
_loc
,
Loc
.
stop_off
_loc
-
Loc
.
start_bol
_loc
in
{
exp_loc
=
loc
;
exp_typ
=
Types
.
any
;
exp_descr
=
Pair
(
e1
,
e2
)
}
]
"pair"
LEFTA
[
e1
=
SELF
;
","
;
e2
=
SELF
->
MPair
(
_loc
,
e1
,
e2
)
]
|
"paren"
[
"("
;
e
=
SELF
;
")"
->
e
]
|
"var"
[
x
=
LIDENT
;
":"
;
t
=
UIDENT
->
let
loc
=
`File
(
Loc
.
file_name
_loc
)
,
Loc
.
start_off
_loc
-
Loc
.
start_bol
_loc
,
Loc
.
stop_off
_loc
-
Loc
.
start_bol
_loc
in
{
exp_loc
=
loc
;
exp_typ
=
Types
.
any
;
exp_descr
=
Var
(
0
,
x
)
}
]
|
"int"
[
x
=
INT
->
let
loc
=
`File
(
Loc
.
file_name
_loc
)
,
Loc
.
start_off
_loc
-
Loc
.
start_bol
_loc
,
Loc
.
stop_off
_loc
-
Loc
.
start_bol
_loc
in
let
x
=
Big_int
.
big_int_of_int
(
int_of_string
x
)
in
{
exp_loc
=
loc
;
exp_typ
=
Types
.
any
;
exp_descr
=
Cst
(
Types
.
Integer
x
)
}
]
|
"string"
[
x
=
STRING
->
let
loc
=
`File
(
Loc
.
file_name
_loc
)
,
Loc
.
start_off
_loc
-
Loc
.
start_bol
_loc
,
Loc
.
stop_off
_loc
-
Loc
.
start_bol
_loc
in
let
x
=
Types
.
String
(
0
,
(
String
.
length
x
)
-
1
,
x
,
Types
.
Integer
(
Big_int
.
big_int_of_int
0
))
in
{
exp_loc
=
loc
;
exp_typ
=
Types
.
any
;
exp_descr
=
Cst
x
}
]
|
"var"
[
x
=
LIDENT
;
":"
;
t
=
UIDENT
->
MVar
(
_loc
,
x
,
t
)
]
|
"int"
[
x
=
INT
->
MInt
(
_loc
,
int_of_string
x
)
]
|
"string"
[
x
=
STRING
->
MString
(
_loc
,
x
)
]
];
END
;;
let
of_string
s
file
=
Gram
.
parse_string
exp_eoi
(
Loc
.
mk
file
)
s
end
let
get_loc
expr
=
match
expr
with
|
Apply
(
loc
,
_
,
_
)
->
loc
|
Abstr
(
loc
,
_
,
_
,
_
,
_
)
->
loc
|
Match
(
loc
,
_
,
_
)
->
loc
|
Pair
(
loc
,
_
,
_
)
->
loc
|
Var
(
loc
,
_
)
->
loc
|
Int
(
loc
,
_
)
->
loc
|
String
(
loc
,
_
)
->
loc
tests/lambda/src/parse.mli
View file @
8367c11b
open
Camlp4
.
PreCast
type
expr
=
|
Apply
of
Loc
.
t
*
expr
*
expr
|
Abstr
of
Loc
.
t
*
fun_name
*
params
*
ptype
*
expr
|
Match
of
Loc
.
t
*
expr
*
branches
|
Pair
of
Loc
.
t
*
expr
*
expr
|
Var
of
Loc
.
t
*
string
|
Int
of
Loc
.
t
*
int
|
String
of
Loc
.
t
*
string
and
fun_name
=
string
and
params
=
(
Loc
.
t
*
string
*
ptype
)
list
and
branches
=
(
Loc
.
t
*
match_value
*
expr
)
list
and
match_value
=
|
MPair
of
Loc
.
t
*
match_value
*
match_value
|
MVar
of
Loc
.
t
*
string
*
ptype
|
MInt
of
Loc
.
t
*
int
|
MString
of
Loc
.
t
*
string
and
ptype
=
string
module
ExprParser
:
sig
val
of_string
:
string
->
string
->
Typed
.
t
expr
val
of_string
:
string
->
string
->
expr
end
val
get_loc
:
expr
->
Loc
.
t
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