[r2002-10-20 21:38:35 by cvscast] Empty log message

Original author: cvscast
Date: 2002-10-20 21:38:36+00:00

driver/cduce.ml

@@ -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

@@ -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

@@ -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

@@ -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"]