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
ac09ecd0
Commit
ac09ecd0
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2002-10-26 17:05:30 by cvscast] Evaluateur tourne !
Original author: cvscast Date: 2002-10-26 17:05:31+00:00
parent
b8755776
Changes
6
Hide whitespace changes
Inline
Side-by-side
Makefile
View file @
ac09ecd0
...
...
@@ -17,14 +17,14 @@ RUNTIME = runtime/value.cmo
DRIVER
=
driver/cduce.cmo
DIRS
=
parser typing types driver
DIRS
=
parser typing types
runtime
driver
OBJECTS
=
$(TYPES)
$(PARSER)
$(TYPING)
$(RUNTIME)
XOBJECTS
=
$(OBJECTS:.cmo=.cmx)
XDRIVER
=
$(DRIVER:.cmo=.cmx)
DEPEND
=
parser/
*
.ml parser/
*
.mli typing/
*
.ml typing/
*
.mli types/
*
.ml types/
*
.mli runtime/
*
.mli runtime/
*
.ml driver/
*
.mli driver/
*
.ml
INCLUDES
=
-I
+camlp4
-I
parser
-I
types
-I
typing
INCLUDES
=
-I
+camlp4
-I
parser
-I
types
-I
runtime
-I
typing
SYNTAX_PARSER
=
-pp
'camlp4o pa_extend.cmo'
...
...
driver/cduce.ml
View file @
ac09ecd0
...
...
@@ -98,7 +98,9 @@ let phrase ph =
|
Ast
.
EvalStatement
e
->
let
(
fv
,
e
)
=
Typer
.
expr
e
in
let
t
=
Typer
.
type_check
Typer
.
Env
.
empty
e
Types
.
any
true
in
Format
.
fprintf
ppf
"%a@
\n
"
print_norm
t
Format
.
fprintf
ppf
"|- %a@
\n
"
print_norm
t
;
let
v
=
Value
.
eval
Value
.
empty_env
e
in
Format
.
fprintf
ppf
"=> %a@
\n
"
Value
.
print
v
|
Ast
.
TypeDecl
_
->
()
|
Ast
.
Debug
l
->
debug
l
|
_
->
assert
false
...
...
runtime/value.mli
View file @
ac09ecd0
type
t
type
env
val
empty_env
:
env
val
print
:
Format
.
formatter
->
t
->
unit
...
...
types/patterns.ml
View file @
ac09ecd0
...
...
@@ -376,7 +376,7 @@ struct
in
aux
f
a
0
let
combine
disp
act
=
let
combine
(
disp
,
act
)
=
if
Array
.
length
act
=
0
then
`None
else
if
(
array_for_all
(
fun
(
_
,
ar
,_
)
->
ar
=
0
)
disp
.
codes
)
...
...
@@ -575,8 +575,32 @@ struct
d
t
selected
unselect
in
let
res
=
Array
.
map
result
disp
.
codes
in
post
(
combine
disp
res
)
post
(
disp
,
res
)
let
make_branches
t
brs
=
let
(
_
,
brs
)
=
List
.
fold_left
(
fun
(
t
,
brs
)
(
p
,
e
)
->
let
p
=
Normal
.
restrict
t
(
Normal
.
nf
p
)
in
let
t
=
Types
.
diff
t
(
p
.
Normal
.
a
)
in
(
t
,
(
p
,
e
)
::
brs
)
)
(
t
,
[]
)
brs
in
let
pl
=
Array
.
map
(
fun
x
->
[
x
])
(
Array
.
of_list
brs
)
in
get_tests
pl
(
fun
x
->
[
x
]
,
[]
)
t
(
fun
_
pl
_
->
let
r
=
ref
None
in
let
aux
=
function
|
[
x
]
->
assert
(
!
r
=
None
);
r
:=
Some
x
|
[]
->
()
|
_
->
assert
false
in
Array
.
iter
aux
pl
;
let
r
=
match
!
r
with
None
->
assert
false
|
Some
x
->
x
in
r
)
(
fun
x
->
x
)
let
rec
dispatch_prod
disp
=
...
...
@@ -586,14 +610,14 @@ struct
(
fun
(
res
,
(
p
,
q
))
->
[
p
,
(
res
,
q
)]
,
[]
)
(
Types
.
Product
.
pi1
t
)
(
dispatch_prod1
disp
t
)
detect_left_tail_call
(
fun
x
->
detect_left_tail_call
(
combine
x
))
and
dispatch_prod1
disp
t
t1
pl
_
=
let
t
=
Types
.
Product
.
restrict_1
t
t1
in
get_tests
pl
(
fun
(
ret1
,
(
res
,
q
))
->
[
q
,
(
ret1
,
res
)]
,
[]
)
(
Types
.
Product
.
pi2
t
)
(
dispatch_prod2
disp
t
)
detect_right_tail_call
(
fun
x
->
detect_right_tail_call
(
combine
x
))
and
dispatch_prod2
disp
t
t2
pl
_
=
let
aux_final
(
ret2
,
(
ret1
,
res
))
=
List
.
map
(
conv_source_prod
ret1
ret2
)
res
in
...
...
@@ -656,7 +680,7 @@ struct
|
x
->
[]
,
[
x
])
(
Types
.
Record
.
project_field
t
l
)
(
dispatch_record_field
l
disp
t
)
(
fun
x
->
x
)
(
fun
x
->
combine
x
)
in
let
absent
=
let
pl
=
label_not_found
l
pl
in
...
...
types/patterns.mli
View file @
ac09ecd0
...
...
@@ -66,4 +66,8 @@ module Compile: sig
val
actions
:
dispatcher
->
actions
val
show
:
Format
.
formatter
->
Types
.
descr
->
normal
array
->
unit
val
make_branches
:
Types
.
descr
->
(
descr
*
'
a
)
list
->
dispatcher
*
((
capture
,
int
)
SortedMap
.
t
*
'
a
)
array
end
typing/typed.ml
View file @
ac09ecd0
...
...
@@ -57,7 +57,18 @@ and branch = {
br_pat
:
tpat
;
br_body
:
texpr
}
and
compiled_branches
=
{
actions
:
Patterns
.
Compile
.
actions
;
rhs
:
(
texpr
*
(
string
*
int
)
list
)
array
}
and
compiled_branches
=
Patterns
.
Compile
.
dispatcher
*
((
string
*
int
)
list
*
texpr
)
array
let
dispatcher
brs
=
match
brs
.
br_compiled
with
|
Some
d
->
d
|
None
->
let
aux
b
=
Patterns
.
descr
b
.
br_pat
,
b
.
br_body
in
let
x
=
Patterns
.
Compile
.
make_branches
brs
.
br_typ
(
List
.
map
aux
brs
.
br_branches
)
in
brs
.
br_compiled
<-
Some
x
;
x
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