Commit 3483655c authored by Pietro Abate's avatar Pietro Abate

[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
......@@ -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"
......
......@@ -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
......
......@@ -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)
......
......@@ -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"]
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment