Better error reporting; synched with ostap

regression/x86only/Lib01.expr

@@ -0,0 +1,3 @@
+public fun from_test005 (s) {
+  printf ("called with %s\n", s)
+}

regression/x86only/Makefile

@@ -1,4 +1,5 @@
 TESTS=$(sort $(basename $(wildcard test*.expr)))
+LIBS=$(sort $(basename $(wildcard Lib*.expr)).o)
 
 RC=../../src/rc.opt
 
@@ -6,8 +7,11 @@ RC=../../src/rc.opt
 
 check: $(TESTS)
 
-$(TESTS): %: %.expr
+%.o: %.expr
-	@RC_RUNTIME=../../runtime $(RC) -I . $< && cat $@.input | ./$@ > $@.log && diff -u $@.log orig/$@.log
+	RC_RUNTIME=../../runtime $(RC) -c -I . $<
+
+$(TESTS): %: %.expr $(LIBS)
+	RC_RUNTIME=../../runtime $(RC) -I . $< && cat $@.input | ./$@ > $@.log && diff -u $@.log orig/$@.log
 
 clean:
-	rm -f test*.log *.s *~ $(TESTS)
+	rm -f test*.log *.i *.o *.s *~ $(TESTS)

regression/x86only/orig/test005.log

@@ -1 +1 @@
-called with this one
+called with that one

regression/x86only/orig/test007.log

@@ -1,24 +0,0 @@
--1
-1
-0
--1
-1
-0
--1
-1
-0
-0
--1
-1
--1
-1
-0
--51
-51
-0
--1
-3
-0
-0
-31
--1

regression/x86only/test005.expr

@@ -1,5 +1,3 @@
-public fun from_test005 (s) {
+import Lib01;
-  printf ("called with %s\n", s)
-}
 
-from_test005 ("this one")
+from_test005 ("that one")

regression/x86only/test006.expr

@@ -1,3 +0,0 @@
-import test005;
-
-from_test005 ("that one")

regression/x86only/test007.i

@@ -1 +0,0 @@
-I,Std;

src/Language.ml

@@ -11,7 +11,8 @@ open Combinators
 
 exception Semantic_error of string
 
-let report_error str = raise (Semantic_error str)
+let report_error ?(loc=None) str =
+  raise (Semantic_error (str ^ match loc with None -> "" | Some (l, c) -> Printf.sprintf " at (%d, %d)" l c))
                      
 module Loc =
   struct
@@ -178,18 +179,18 @@ module State =
     (* Update: non-destructively "modifies" the state s by binding the variable x
        to value v and returns the new state w.r.t. a scope
     *)
-    let update x v s =      
+    let update ?(loc=None) x v s =      
       let rec inner = function
-      | I -> report_error "uninitialized state"
+      | I -> report_error ~loc:loc "uninitialized state"
       | G (scope, s) ->
          if is_var x scope
          then G (scope, bind x v s)
-         else report_error (Printf.sprintf "name %s is undefined or does not designate a variable" x)
+         else report_error ~loc:loc (Printf.sprintf "name %s is undefined or does not designate a variable" x)
       | L (scope, s, enclosing) ->
          if in_scope x scope
          then if is_var x scope
               then L (scope, bind x v s, enclosing)
-              else report_error (Printf.sprintf "name %s does not designate a variable" x)
+              else report_error ~loc:loc (Printf.sprintf "name %s does not designate a variable" x)
          else L (scope, s, inner enclosing)
       in
       inner s      
@@ -551,7 +552,7 @@ module Expr =
     | Weak -> Seq (expr, Const 0)
     | _    -> expr
     
-  (* semantics for infixes creaed in runtime *)
+  (* semantics for infixes created in runtime *)
   let sem s = (fun x atr y -> ignore atr (Call (Var s, [x; y]))), (fun _ -> Val, Val)
 
   let sem_init s = fun x atr y ->
@@ -595,6 +596,7 @@ module Expr =
       ostap (inner[0][id][atr])
       
     let atr' = atr
+    let not_a_reference s = new Reason.t (Msg.make "not a reference" [||] (Msg.Locator.Point s#coord))
                             
     (* ======= *)
     ostap (
@@ -653,21 +655,21 @@ module Expr =
         }
         | base[def][infix][atr];
       base[def][infix][atr]:
-        n:DECIMAL                                 => {notRef atr} => {ignore atr (Const n)}
+        l:$ n:DECIMAL                              => {notRef atr} :: (not_a_reference l) => {ignore atr (Const n)}
-      | s:STRING                                  => {notRef atr} => {ignore atr (String s)}
+      | l:$ s:STRING                               => {notRef atr} :: (not_a_reference l)=> {ignore atr (String s)}
-      | c:CHAR                                    => {notRef atr} => {ignore atr (Const  (Char.code c))}
+      | l:$ c:CHAR                                 => {notRef atr} :: (not_a_reference l) => {ignore atr (Const  (Char.code c))}
       
-      | c:(%"true" {Const 1} | %"false" {Const 0}) => {notRef atr} => {ignore atr c} 
+      | l:$ c:(%"true" {Const 1} | %"false" {Const 0}) => {notRef atr} :: (not_a_reference l) => {ignore atr c} 
        
-      | %"infix" s:STRING                         => {notRef atr} => {ignore atr (Var (infix_name s))}
+      | l:$ %"infix" s:STRING                         => {notRef atr}  :: (not_a_reference l) => {ignore atr (Var (infix_name s))}
-      | %"fun" "(" args:!(Util.list0)[ostap (LIDENT)] ")" "{" body:scope[def][infix][Weak][parse def] "}"=> {notRef atr} => {ignore atr (Lambda (args, body))}
+      | l:$ %"fun" "(" args:!(Util.list0)[ostap (LIDENT)] ")" "{" body:scope[def][infix][Weak][parse def] "}"=> {notRef atr} :: (not_a_reference l) => {ignore atr (Lambda (args, body))}
-      | "[" es:!(Util.list0)[parse def infix Val] "]" => {notRef atr} => {ignore atr (Array es)}
+      | l:$ "[" es:!(Util.list0)[parse def infix Val] "]" => {notRef atr} :: (not_a_reference l) => {ignore atr (Array es)}
       | -"{" scope[def][infix][atr][parse def] -"}" 
-      | "{" es:!(Util.list0)[parse def infix Val] "}" => {notRef atr} => {ignore atr (match es with
+      | l:$ "{" es:!(Util.list0)[parse def infix Val] "}" => {notRef atr} :: (not_a_reference l) => {ignore atr (match es with
                                                                                       | [] -> Const 0
                                                                                       | _  -> List.fold_right (fun x acc -> Sexp ("cons", [x; acc])) es (Const 0))
                                                                          }
-      | t:UIDENT args:(-"(" !(Util.list)[parse def infix Val] -")")? => {notRef atr} => {ignore atr (Sexp (t, match args with
+      | l:$ t:UIDENT args:(-"(" !(Util.list)[parse def infix Val] -")")? => {notRef atr} :: (not_a_reference l) => {ignore atr (Sexp (t, match args with
                                                                                                               | None -> []
                                                                                                               | Some args -> args))
                                                                                         }

src/SM.ml

@@ -545,7 +545,7 @@ object (self : 'self)
     match m with
     | `Local -> ()
     |  _  ->
-       raise (Semantic_error (Printf.sprintf "external/public definitions ('%s') not allowed in local scopes" name))    
+       report_error (Printf.sprintf "external/public definitions ('%s') not allowed in local scopes" name)    
     
   method add_name (name : string) (m : [`Local | `Extern | `Public | `PublicExtern]) (mut : bool) = {<
       decls = (name, m, false) :: decls;
@@ -598,7 +598,7 @@ object (self : 'self)
          fundefs = add_fun fundefs (to_fundef name' args body scope.st)
        >} # register_fun name'
 
-  method lookup name =
+  method lookup l name =
     match State.eval scope.st name with
     | Value.Access n when n = ~-1 ->
        let index         = scope.acc_index in
@@ -607,7 +607,7 @@ object (self : 'self)
          fundefs = fundefs';
          scope   = {
            scope with
-           st        = State.update name (Value.Access index) scope.st;
+           st        = State.update ~loc:l name (Value.Access index) scope.st;
            acc_index = scope.acc_index + 1;
            closure   = loc :: scope.closure
          }
@@ -683,7 +683,7 @@ let compile cmd ((imports, infixes), p) =
       List.fold_left
         (fun (env, acc) (name, path) ->
            let env = env#add_name name `Local true in
-           let env, dsg = env#lookup name in
+           let env, dsg = env#lookup None name in
            env,
            ([DUP] @
             List.concat (List.map (fun i -> [CONST i; CALL (".elem", 2)]) path) @
@@ -730,8 +730,8 @@ let compile cmd ((imports, infixes), p) =
                                add_code (compile_expr ls env s) ls false [DROP]                             
 
   | Expr.ElemRef (x, i)     -> compile_list l env [x; i]                               
-  | Expr.Var      x         -> let env, acc = env#lookup x in (match acc with Value.Fun name -> env#register_call name, false, [PROTO (name, env#current_function)] | _ -> env, false, [LD acc])
+  | Expr.Var      x         -> let env, acc = env#lookup None x in (match acc with Value.Fun name -> env#register_call name, false, [PROTO (name, env#current_function)] | _ -> env, false, [LD acc])
-  | Expr.Ref      x         -> let env, acc = env#lookup x in env, false, [LDA acc]
+  | Expr.Ref      x         -> let env, acc = env#lookup None x in env, false, [LDA acc]
   | Expr.Const    n         -> env, false, [CONST n]
   | Expr.String   s         -> env, false, [STRING s]
   | Expr.Binop (op, x, y)   -> let lop, env = env#get_label in
@@ -740,7 +740,7 @@ let compile cmd ((imports, infixes), p) =
   | Expr.Call (f, args)     -> let lcall, env = env#get_label in
                                (match f with
                                 | Expr.Var name ->
-                                   let env, acc = env#lookup name in
+                                   let env, acc = env#lookup None name in
                                    (match acc with
                                     | Value.Fun name ->
                                        let env = env#register_call name in

stdlib/Makefile

@@ -0,0 +1,11 @@
+FILES=$(wildcard *.expr)
+ALL=$(sort $(FILES:.expr=.o))
+
+all: $(ALL)
+
+%.o: %.expr
+	../src/rc.opt -c $<
+
+clean:
+	rm -Rf *.s *.o *.i *~
+

stdlib/Matcher.expr

@@ -68,8 +68,7 @@ fun matcherCreate (buf, pos, line, col) {
   [show,
    eof,
    matchString,
-   matchRegexp
+   matchRegexp]  
-  ]
 }
 
 fun show (m) {

stdlib/regression/test006.expr

@@ -16,12 +16,14 @@ write (compare (A, B));
 write (compare (B, A));
 write (compare (A (1), A (1, 1)));
 write (compare (A (1, 1), A (1)));
-write (compare (f, f));
+
-write (compare (f, f(5)));
+-- not stable: write (compare (f, f));
-write (compare (f(5), f)); 
+-- not stable: write (compare (f, f(5)));
-write (compare (f(5), f(5)));
+-- not stable: write (compare (f(5), f)); 
-write (compare (f(5), f(6)));
+-- not stable: write (compare (f(5), f(5)));
-write (compare (f(6), f(5)));
+-- not stable: write (compare (f(5), f(6)));
+-- not stable: write (compare (f(6), f(5)));
+
 write (compare ({1, 2, 3}, {1, 2, 3}));
 write (compare ({1, [2], [[3]]}, {1, [2], [[3]]}));
 write (compare ({1, [2], [[3]]}, {1, [2], [3]}));