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
3483655c
Commit
3483655c
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2002-10-20 21:38:35 by cvscast] Empty log message
Original author: cvscast Date: 2002-10-20 21:38:36+00:00
parent
0c1cf7af
Changes
4
Hide whitespace changes
Inline
Side-by-side
driver/cduce.ml
View file @
3483655c
...
...
@@ -7,10 +7,10 @@ let () =
Builtin
.
types
let
input_channel
=
let
(
source
,
input_channel
)
=
match
Array
.
length
Sys
.
argv
with
|
1
->
stdin
|
2
->
open_in
Sys
.
argv
.
(
1
)
|
1
->
(
""
,
stdin
)
|
2
->
let
s
=
Sys
.
argv
.
(
1
)
in
(
s
,
open_in
s
)
|
_
->
raise
Usage
let
input
=
Stream
.
of_channel
input_channel
...
...
@@ -23,7 +23,18 @@ let prog () =
let
rec
print_exn
ppf
=
function
|
Location
((
i
,
j
)
,
exn
)
->
Format
.
fprintf
ppf
"Error at chars %i-%i@
\n
"
i
j
;
if
source
=
""
then
Format
.
fprintf
ppf
"Error at chars %i-%i@
\n
"
i
j
else
(
let
(
l1
,
c1
)
=
Location
.
get_line_number
source
i
and
(
l2
,
c2
)
=
Location
.
get_line_number
source
j
in
if
l1
=
l2
then
Format
.
fprintf
ppf
"Error at line %i (chars %i-%i)@
\n
"
l1
c1
c2
else
Format
.
fprintf
ppf
"Error at lines %i (char %i) - %i (char %i)@
\n
"
l1
c1
l2
c2
);
print_exn
ppf
exn
|
Typer
.
ShouldHave
(
t
,
msg
)
->
Format
.
fprintf
ppf
"This expression should have type %a@
\n
%s@
\n
"
...
...
parser/location.ml
View file @
3483655c
...
...
@@ -3,6 +3,22 @@ exception Location of loc * exn
let
noloc
=
(
-
1
,-
1
)
let
get_line_number
src
i
=
let
ic
=
open_in_bin
src
in
let
rec
aux
pos
line
start
=
if
(
pos
>=
i
)
then
(
line
,
i
-
start
)
else
match
input_char
ic
with
|
'\r'
when
pos
=
start
->
aux
(
pos
+
1
)
line
(
pos
+
1
)
|
'\r'
|
'\n'
->
aux
(
pos
+
1
)
(
line
+
1
)
(
pos
+
1
)
|
_
->
aux
(
pos
+
1
)
line
start
in
let
r
=
aux
0
1
0
in
close_in
ic
;
r
type
'
a
located
=
{
loc
:
loc
;
descr
:
'
a
}
type
expr
=
A
|
B
of
expr
located
...
...
parser/location.mli
View file @
3483655c
...
...
@@ -2,6 +2,8 @@ type loc = int * int
exception
Location
of
loc
*
exn
val
noloc
:
loc
val
get_line_number
:
string
->
int
->
int
*
int
type
'
a
located
=
{
loc
:
loc
;
descr
:
'
a
}
val
recurs
:
((
'
a
located
->
'
b
)
->
loc
->
'
a
->
'
b
)
->
(
'
a
located
->
'
b
)
...
...
tests/addrbook.cd
View file @
3483655c
...
...
@@ -4,6 +4,9 @@ type Name = <name>[String];;
type Addr = <addr>[String];;
type Tel = <tel>[String];;
fun (Int -> Int) 0
-> 1;;
<addrbook>[
<name>["Haruo Hosoya"]
<addr>["Tokyo"]
...
...
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