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
80304e58
Commit
80304e58
authored
Jul 10, 2007
by
Pietro Abate
Browse files
[r2005-07-07 08:58:53 by afrisch] Empty log message
Original author: afrisch Date: 2005-07-07 08:58:53+00:00
parent
d9ed50d0
Changes
8
Hide whitespace changes
Inline
Side-by-side
compile/auto_pat.ml
View file @
80304e58
...
...
@@ -33,7 +33,7 @@ and state = {
arity
:
int
array
;
mutable
actions
:
actions
;
mutable
fail_code
:
int
;
mutable
expected_type
:
Types
.
t
mutable
expected_type
:
string
;
}
...
...
compile/auto_pat.mli
View file @
80304e58
...
...
@@ -33,7 +33,7 @@ and state = {
arity
:
int
array
;
mutable
actions
:
actions
;
mutable
fail_code
:
int
;
mutable
expected_type
:
Types
.
t
mutable
expected_type
:
string
;
}
...
...
runtime/eval.ml
View file @
80304e58
...
...
@@ -9,13 +9,6 @@ let ops = Hashtbl.create 13
let
register_op
=
Hashtbl
.
add
ops
let
eval_op
=
Hashtbl
.
find
ops
let
print_to_string
f
x
=
let
b
=
Buffer
.
create
1024
in
let
ppf
=
Format
.
formatter_of_buffer
b
in
f
ppf
x
;
Buffer
.
contents
b
(* To write tail-recursive map-like iteration *)
let
make_accu
()
=
Value
.
Pair
(
nil
,
Absent
)
...
...
runtime/explain.ml
View file @
80304e58
...
...
@@ -4,21 +4,22 @@ open Auto_pat
open
Encodings
type
t
=
(
Value
.
t
*
Types
.
t
)
list
type
t
=
(
Value
.
t
*
string
)
list
let
rec
print
ppf
=
function
|
[]
->
()
|
(
v
,
t
)
::
l
->
print
ppf
l
;
Format
.
fprintf
ppf
"Value @[%a@] does not match type @[%
a
@]@."
"Value @[%a@] does not match type @[%
s
@]@."
Value
.
print
v
Types
.
Print
.
print
t
t
let
print_to_string
f
x
=
let
b
=
Buffer
.
create
1024
in
let
ppf
=
Format
.
formatter_of_buffer
b
in
f
ppf
x
;
Format
.
pp_print_flush
ppf
()
;
Buffer
.
contents
b
let
to_string
e
=
...
...
@@ -133,14 +134,6 @@ let explain d v =
try
check
d
v
;
None
with
Failed
p
->
Some
p
let
print_to_string
f
x
=
let
b
=
Buffer
.
create
1024
in
let
ppf
=
Format
.
formatter_of_buffer
b
in
f
ppf
x
;
Buffer
.
contents
b
let
do_check
d
v
=
try
check
d
v
;
v
with
Failed
p
->
...
...
runtime/explain.mli
View file @
80304e58
type
t
=
(
Value
.
t
*
Types
.
t
)
list
type
t
=
(
Value
.
t
*
string
)
list
exception
Failed
of
t
...
...
types/patterns.ml
View file @
80304e58
...
...
@@ -978,7 +978,7 @@ module Compile = struct
arity
=
Array
.
map
(
fun
(
_
,
ar
,_
)
->
ar
)
codes
;
actions
=
dummy_actions
;
fail_code
=
(
-
1
);
expected_type
=
Types
.
empty
expected_type
=
""
;
}
in
let
disp
=
{
id
=
!
cur_id
;
...
...
@@ -1244,10 +1244,12 @@ module Compile = struct
assert
(
state
.
fail_code
==
fail
);
)
else
(
state
.
fail_code
<-
fail
;
let
expect
=
ref
Types
.
empty
in
Array
.
iteri
(
fun
i
(
t
,_,_
)
->
if
i
!=
fail
then
state
.
expected_type
<-
Types
.
cup
t
state
.
expected_type
)
if
i
!=
fail
then
expect
:=
Types
.
cup
t
!
expect
)
(
Hashtbl
.
find
dispatcher_of_state
state
.
uid
)
.
codes
;
state
.
expected_type
<-
Types
.
Print
.
to_string
!
expect
;
prepare_checker_actions
fail
state
.
actions
)
and
prepare_checker_actions
fail
=
function
...
...
types/types.ml
View file @
80304e58
...
...
@@ -1517,6 +1517,16 @@ struct
let
print_node
ppf
n
=
print
ppf
(
descr
n
)
let
()
=
forward_print
:=
print
let
print_to_string
f
x
=
let
b
=
Buffer
.
create
1024
in
let
ppf
=
Format
.
formatter_of_buffer
b
in
f
ppf
x
;
Format
.
pp_print_flush
ppf
()
;
Buffer
.
contents
b
let
to_string
t
=
print_to_string
print
t
end
module
Positive
=
...
...
types/types.mli
View file @
80304e58
...
...
@@ -272,6 +272,8 @@ sig
(* Don't try to find a global name at toplevel *)
val
print_noname
:
Format
.
formatter
->
t
->
unit
val
to_string
:
t
->
string
end
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