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
12866377
Commit
12866377
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2002-10-27 07:00:51 by cvscast] Empty log message
Original author: cvscast Date: 2002-10-27 07:00:51+00:00
parent
d00e7bc0
Changes
3
Hide whitespace changes
Inline
Side-by-side
runtime/value.ml
View file @
12866377
...
...
@@ -116,7 +116,11 @@ let dummy_r = [||]
let
rec
run_dispatcher
d
v
=
let
actions
=
Patterns
.
Compile
.
actions
d
in
match
v
with
match
actions
with
|
`Ignore
r
->
make_result_basic
v
r
|
`Kind
k
->
run_disp_kind
k
v
and
run_disp_kind
actions
v
=
match
v
with
|
Pair
(
v1
,
v2
)
->
run_disp_prod
v
v1
v2
actions
.
Patterns
.
Compile
.
prod
|
Record
r
->
run_disp_record
v
[]
r
actions
.
Patterns
.
Compile
.
record
|
Atom
a
->
...
...
types/patterns.ml
View file @
12866377
...
...
@@ -324,7 +324,10 @@ end
module
Compile
=
struct
type
actions
=
{
type
actions
=
[
`Ignore
of
result
|
`Kind
of
actions_kind
]
and
actions_kind
=
{
basic
:
(
Types
.
descr
*
result
)
list
;
prod
:
result
dispatch
dispatch
;
record
:
record
option
;
...
...
@@ -378,6 +381,27 @@ struct
in
aux
f
a
0
let
combine_kind
basic
prod
record
=
try
(
let
rs
=
[]
in
let
rs
=
match
basic
with
|
[
_
,
r
]
->
r
::
rs
|
[]
->
rs
|
_
->
raise
Exit
in
let
rs
=
match
prod
with
|
`None
->
rs
|
`Ignore
(
`Ignore
r
)
->
r
::
rs
|
_
->
raise
Exit
in
let
rs
=
match
record
with
|
None
->
rs
|
Some
(
`Result
r
)
->
r
::
rs
|
_
->
raise
Exit
in
match
rs
with
|
r
::
rs
when
List
.
for_all
(
(
=
)
r
)
rs
->
`Ignore
r
|
_
->
raise
Exit
)
with
Exit
->
`Kind
{
basic
=
basic
;
prod
=
prod
;
record
=
record
}
let
combine
(
disp
,
act
)
=
if
Array
.
length
act
=
0
then
`None
else
...
...
@@ -705,11 +729,11 @@ struct
match
disp
.
actions
with
|
Some
a
->
a
|
None
->
let
a
=
{
basic
=
dispatch_basic
disp
;
prod
=
dispatch_prod
disp
;
record
=
dispatch_record
disp
;
}
in
let
a
=
combine_kind
(
dispatch_basic
disp
)
(
dispatch_prod
disp
)
(
dispatch_record
disp
)
in
disp
.
actions
<-
Some
a
;
a
...
...
@@ -722,26 +746,27 @@ struct
to_print
:=
d
::
!
to_print
)
let
print_actions
ppf
actions
=
let
print_source
ppf
=
function
|
`Catch
->
Format
.
fprintf
ppf
"v"
|
`Const
c
->
Types
.
Print
.
print_const
ppf
c
|
`Left
i
->
Format
.
fprintf
ppf
"l%i"
i
|
`Right
j
->
Format
.
fprintf
ppf
"r%i"
j
|
`Recompose
(
i
,
j
)
->
Format
.
fprintf
ppf
"(l%i,r%i)"
i
j
|
`Field
(
l
,
i
)
->
Format
.
fprintf
ppf
"%s%i"
(
Types
.
label_name
l
)
i
in
let
print_result
ppf
=
Array
.
iteri
(
fun
i
s
->
if
i
>
0
then
Format
.
fprintf
ppf
","
;
print_source
ppf
s
;
)
in
let
print_ret
ppf
(
code
,
ret
)
=
Format
.
fprintf
ppf
"$%i"
code
;
if
Array
.
length
ret
<>
0
then
Format
.
fprintf
ppf
"(%a)"
print_result
ret
in
let
print_source
ppf
=
function
|
`Catch
->
Format
.
fprintf
ppf
"v"
|
`Const
c
->
Types
.
Print
.
print_const
ppf
c
|
`Left
i
->
Format
.
fprintf
ppf
"l%i"
i
|
`Right
j
->
Format
.
fprintf
ppf
"r%i"
j
|
`Recompose
(
i
,
j
)
->
Format
.
fprintf
ppf
"(l%i,r%i)"
i
j
|
`Field
(
l
,
i
)
->
Format
.
fprintf
ppf
"%s%i"
(
Types
.
label_name
l
)
i
let
print_result
ppf
=
Array
.
iteri
(
fun
i
s
->
if
i
>
0
then
Format
.
fprintf
ppf
","
;
print_source
ppf
s
;
)
let
print_ret
ppf
(
code
,
ret
)
=
Format
.
fprintf
ppf
"$%i"
code
;
if
Array
.
length
ret
<>
0
then
Format
.
fprintf
ppf
"(%a)"
print_result
ret
let
print_kind
ppf
actions
=
let
print_lhs
ppf
(
code
,
prefix
,
d
)
=
let
arity
=
match
d
.
codes
.
(
code
)
with
(
_
,
a
,_
)
->
a
in
Format
.
fprintf
ppf
"$%i("
code
;
...
...
@@ -835,6 +860,10 @@ struct
print_prod
actions
.
prod
;
print_record_opt
ppf
actions
.
record
let
print_actions
ppf
=
function
|
`Kind
k
->
print_kind
ppf
k
|
`Ignore
r
->
Format
.
fprintf
ppf
"v -> %a@
\n
"
print_ret
r
let
rec
print_dispatchers
ppf
=
match
!
to_print
with
|
[]
->
()
...
...
types/patterns.mli
View file @
12866377
...
...
@@ -41,7 +41,10 @@ module Compile: sig
type
dispatcher
val
dispatcher
:
Types
.
descr
->
normal
array
->
dispatcher
type
actions
=
{
type
actions
=
[
`Ignore
of
result
|
`Kind
of
actions_kind
]
and
actions_kind
=
{
basic
:
(
Types
.
descr
*
result
)
list
;
prod
:
result
dispatch
dispatch
;
record
:
record
option
;
...
...
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