diff --git a/regression/x86only/Lib01.expr b/regression/x86only/Lib01.expr new file mode 100644 index 000000000..d049c6104 --- /dev/null +++ b/regression/x86only/Lib01.expr @@ -0,0 +1,3 @@ +public fun from_test005 (s) { + printf ("called with %s\n", s) +} diff --git a/regression/x86only/Makefile b/regression/x86only/Makefile index 1d5c64d48..2c5369d41 100644 --- a/regression/x86only/Makefile +++ b/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 - @RC_RUNTIME=../../runtime $(RC) -I . $< && cat $@.input | ./$@ > $@.log && diff -u $@.log orig/$@.log +%.o: %.expr + 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) diff --git a/regression/x86only/orig/test005.log b/regression/x86only/orig/test005.log index 44eef781d..e47347ed8 100644 --- a/regression/x86only/orig/test005.log +++ b/regression/x86only/orig/test005.log @@ -1 +1 @@ -called with this one +called with that one diff --git a/regression/x86only/orig/test007.log b/regression/x86only/orig/test007.log deleted file mode 100644 index 38c9e0579..000000000 --- a/regression/x86only/orig/test007.log +++ /dev/null @@ -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 diff --git a/regression/x86only/test005.expr b/regression/x86only/test005.expr index 2efee99f5..b3738162c 100644 --- a/regression/x86only/test005.expr +++ b/regression/x86only/test005.expr @@ -1,5 +1,3 @@ -public fun from_test005 (s) { - printf ("called with %s\n", s) -} +import Lib01; -from_test005 ("this one") \ No newline at end of file +from_test005 ("that one") \ No newline at end of file diff --git a/regression/x86only/test006.expr b/regression/x86only/test006.expr deleted file mode 100644 index da49c4cc3..000000000 --- a/regression/x86only/test006.expr +++ /dev/null @@ -1,3 +0,0 @@ -import test005; - -from_test005 ("that one") \ No newline at end of file diff --git a/regression/x86only/test007.i b/regression/x86only/test007.i deleted file mode 100644 index 517e120ae..000000000 --- a/regression/x86only/test007.i +++ /dev/null @@ -1 +0,0 @@ -I,Std; diff --git a/src/Language.ml b/src/Language.ml index 0c6e58d09..820e0e3c1 100644 --- a/src/Language.ml +++ b/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 @@ -316,7 +317,7 @@ module Expr = (* array *) | Array of t list (* string *) | String of string (* S-expressions *) | Sexp of string * t list - (* variable *) | Var of string + (* variable *) | Var of string (* reference (aka "lvalue") *) | Ref of string (* binary operator *) | Binop of string * t * t (* element extraction *) | Elem of t * t @@ -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,7 +596,8 @@ 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 ( parse[def][infix][atr]: h:basic[def][infix][Void] -";" t:parse[def][infix][atr] {Seq (h, t)} @@ -653,21 +655,21 @@ module Expr = } | base[def][infix][atr]; base[def][infix][atr]: - n:DECIMAL => {notRef atr} => {ignore atr (Const n)} - | s:STRING => {notRef atr} => {ignore atr (String s)} - | c:CHAR => {notRef atr} => {ignore atr (Const (Char.code c))} + l:$ n:DECIMAL => {notRef atr} :: (not_a_reference l) => {ignore atr (Const n)} + | l:$ s:STRING => {notRef atr} :: (not_a_reference l)=> {ignore atr (String s)} + | 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))} - | %"fun" "(" args:!(Util.list0)[ostap (LIDENT)] ")" "{" body:scope[def][infix][Weak][parse def] "}"=> {notRef atr} => {ignore atr (Lambda (args, body))} - | "[" es:!(Util.list0)[parse def infix Val] "]" => {notRef atr} => {ignore atr (Array es)} + | l:$ %"infix" s:STRING => {notRef atr} :: (not_a_reference l) => {ignore atr (Var (infix_name s))} + | 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))} + | 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)) } diff --git a/src/SM.ml b/src/SM.ml index 2d42b505e..bb72643f9 100644 --- a/src/SM.ml +++ b/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.Ref x -> let env, acc = env#lookup x in env, false, [LDA 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 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 diff --git a/stdlib/Makefile b/stdlib/Makefile new file mode 100644 index 000000000..fcdf58af6 --- /dev/null +++ b/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 *~ + diff --git a/stdlib/Matcher.expr b/stdlib/Matcher.expr index 77d9749ba..31b486fad 100644 --- a/stdlib/Matcher.expr +++ b/stdlib/Matcher.expr @@ -68,8 +68,7 @@ fun matcherCreate (buf, pos, line, col) { [show, eof, matchString, - matchRegexp - ] + matchRegexp] } fun show (m) { diff --git a/regression/x86only/test007.expr b/stdlib/regression/test006.expr similarity index 70% rename from regression/x86only/test007.expr rename to stdlib/regression/test006.expr index 55d16b87f..dca90c2f6 100644 --- a/regression/x86only/test007.expr +++ b/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))); -write (compare (f(5), f)); -write (compare (f(5), f(5))); -write (compare (f(5), f(6))); -write (compare (f(6), f(5))); + +-- not stable: write (compare (f, f)); +-- not stable: write (compare (f, f(5))); +-- not stable: write (compare (f(5), f)); +-- not stable: write (compare (f(5), 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]})); diff --git a/stdlib/test01.expr b/stdlib/regression/test01.expr similarity index 100% rename from stdlib/test01.expr rename to stdlib/regression/test01.expr