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
3c4ae863
Commit
3c4ae863
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2002-10-26 01:35:24 by cvscast] Empty log message
Original author: cvscast Date: 2002-10-26 01:35:24+00:00
parent
b95f6802
Changes
9
Expand all
Hide whitespace changes
Inline
Side-by-side
driver/cduce.ml
View file @
3c4ae863
...
...
@@ -70,6 +70,29 @@ let rec print_exn ppf = function
|
exn
->
Format
.
fprintf
ppf
"%s@
\n
"
(
Printexc
.
to_string
exn
)
let
debug
=
function
|
`Filter
(
t
,
p
)
->
Format
.
fprintf
ppf
"[DEBUG:filter]@
\n
"
;
let
t
=
Typer
.
typ
t
and
p
=
Typer
.
pat
p
in
let
f
=
Patterns
.
filter
(
Types
.
descr
t
)
p
in
List
.
iter
(
fun
(
x
,
t
)
->
Format
.
fprintf
ppf
" x:%a@
\n
"
print_norm
(
Types
.
descr
t
))
f
|
`Accept
p
->
Format
.
fprintf
ppf
"[DEBUG:accept]@
\n
"
;
let
p
=
Typer
.
pat
p
in
let
t
=
Patterns
.
accept
p
in
Format
.
fprintf
ppf
" %a@
\n
"
Types
.
Print
.
print
t
|
`Compile
(
t
,
pl
)
->
Format
.
fprintf
ppf
"[DEBUG:compile]@
\n
"
;
let
t
=
Typer
.
typ
t
and
pl
=
List
.
map
Typer
.
pat
pl
in
let
pl
=
Array
.
of_list
(
List
.
map
(
fun
p
->
Patterns
.
Compile
.
normal
(
Patterns
.
descr
p
))
pl
)
in
Patterns
.
Compile
.
show
ppf
(
Types
.
descr
t
)
pl
|
_
->
Format
.
fprintf
ppf
"Unknown or ill-formed debugging directive !! @
\n
"
let
phrase
ph
=
match
ph
.
descr
with
|
Ast
.
EvalStatement
e
->
...
...
@@ -77,6 +100,7 @@ let phrase ph =
let
t
=
Typer
.
type_check
Typer
.
Env
.
empty
e
Types
.
any
true
in
Format
.
fprintf
ppf
"%a@
\n
"
print_norm
t
|
Ast
.
TypeDecl
_
->
()
|
Ast
.
Debug
l
->
debug
l
|
_
->
assert
false
let
()
=
...
...
parser/ast.ml
View file @
3c4ae863
...
...
@@ -11,7 +11,12 @@ and pmodule_item' =
|
FunDecl
of
abstr
|
LetDecl
of
ppat
*
pexpr
|
EvalStatement
of
pexpr
|
Debug
of
string
*
([
`Pat
of
ppat
|
`Expr
of
pexpr
]
list
)
|
Debug
of
debug_directive
and
debug_directive
=
[
`Filter
of
ppat
*
ppat
|
`Accept
of
ppat
|
`Compile
of
ppat
*
ppat
list
]
and
pexpr
=
pexpr'
located
and
pexpr'
=
...
...
parser/parser.ml
View file @
3c4ae863
...
...
@@ -43,7 +43,16 @@ EXTEND
phrase
:
[
[
e
=
expr
->
EvalStatement
e
|
"type"
;
x
=
UIDENT
;
"="
;
t
=
pat
->
TypeDecl
(
x
,
t
)
]
|
"type"
;
x
=
UIDENT
;
"="
;
t
=
pat
->
TypeDecl
(
x
,
t
)
|
"debug"
;
d
=
debug_directive
->
Debug
d
]
];
debug_directive
:
[
[
LIDENT
"filter"
;
t
=
pat
;
p
=
pat
->
`Filter
(
t
,
p
)
|
LIDENT
"accept"
;
p
=
pat
->
`Accept
p
;
|
LIDENT
"compile"
;
t
=
pat
;
p
=
LIST1
pat
->
`Compile
(
t
,
p
)
]
];
expr
:
[
...
...
types/builtin.ml
View file @
3c4ae863
...
...
@@ -4,5 +4,8 @@ let types =
"Any"
,
Types
.
any
;
"Int"
,
Types
.
Int
.
any
;
"Char"
,
Types
.
char
Chars
.
any
;
"Atom"
,
Types
.
atom
Atoms
.
any
"Atom"
,
Types
.
atom
Atoms
.
any
;
"Pair"
,
Types
.
Product
.
any
;
"Arrow"
,
Types
.
Arrow
.
any
;
"Record"
,
Types
.
Record
.
any
;
];
types/chars.ml
View file @
3c4ae863
...
...
@@ -79,5 +79,6 @@ let print =
then
fun
ppf
->
Unichar
.
print
ppf
a
else
fun
ppf
->
if
a
=
0
&&
b
=
max_char
then
Format
.
fprintf
ppf
"Char"
else
Format
.
fprintf
ppf
"%a--%a"
Unichar
.
print
a
Unichar
.
print
b
)
types/intervals.ml
View file @
3c4ae863
...
...
@@ -67,7 +67,7 @@ let rec iadd_bounded l a b = match l with
iadd_bounded
l'
(
min_big_int
a
a1
)
(
max_big_int
b
b1
)
|
Left
b1
::
l'
->
iadd_left
l'
b
|
Right
a1
::
_
->
[
Right
a
]
|
Right
a1
::
_
->
[
Right
(
min_big_int
a
a1
)
]
|
Any
::
_
->
any
let
rec
iadd_right
l
a
=
match
l
with
...
...
types/patterns.ml
View file @
3c4ae863
This diff is collapsed.
Click to expand it.
types/patterns.mli
View file @
3c4ae863
...
...
@@ -34,16 +34,10 @@ val filter : Types.descr -> node -> (capture,Types.node) SortedMap.t
(* Pattern matching: compilation *)
module
NF
:
sig
type
nf
type
normal
val
nf
:
descr
->
nf
val
normal
:
nf
->
normal
module
Disp
:
sig
val
show
:
Format
.
formatter
->
Types
.
descr
->
normal
array
->
unit
end
(*
val show : Format.formatter -> Types.descr -> nf list -> unit
val get : int -> Types.descr * normal list
*)
module
Compile
:
sig
type
normal
val
normal
:
descr
->
normal
type
dispatcher
val
show
:
Format
.
formatter
->
Types
.
descr
->
normal
array
->
unit
end
types/types.ml
View file @
3c4ae863
...
...
@@ -638,10 +638,10 @@ struct
print_union
ppf
(
Intervals
.
print
d
.
ints
@
Chars
.
print
d
.
chars
@
Atoms
.
print
"
Any
Atom"
print_atom
d
.
atoms
@
Boolean
.
print
"
(Any,Any)
"
print_times
d
.
times
@
Boolean
.
print
"
(Empty -> Any)
"
print_arrow
d
.
arrow
@
Boolean
.
print
"
{ }
"
print_record
d
.
record
Atoms
.
print
"Atom"
print_atom
d
.
atoms
@
Boolean
.
print
"
Pair
"
print_times
d
.
times
@
Boolean
.
print
"
Arrow
"
print_arrow
d
.
arrow
@
Boolean
.
print
"
Record
"
print_record
d
.
record
)
and
print_times
ppf
(
t1
,
t2
)
=
Format
.
fprintf
ppf
"@[(%a,%a)@]"
print
t1
print
t2
...
...
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