st/lama_byterun
1
0
Fork 0
mirror of https://github.com/ProgramSnail/Lama.git synced 2025-12-06 06:48:48 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Better error reporting; synched with ostap

Browse source
This commit is contained in:
Dmitry Boulytchev 2020-01-05 22:54:09 +03:00
parent 290c124be6
commit b6180d8634
13 changed files with 59 additions and 68 deletions
Download patch file Download diff file Expand all files Collapse all files

3
regression/x86only/Lib01.expr Normal file
View file

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

10
regression/x86only/Makefile
View file

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

2
regression/x86only/orig/test005.log
View file

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

24
regression/x86only/orig/test007.log
View file

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

6
regression/x86only/test005.expr
View file

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

3
regression/x86only/test006.expr
View file

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

1
regression/x86only/test007.i
View file

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

36
src/Language.ml
View file

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

14
src/SM.ml
View file

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

11
stdlib/Makefile Normal file
View file

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

3
stdlib/Matcher.expr
View file

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

14
regression/x86only/test007.expr → stdlib/regression/test006.expr
View file

@ -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]}));

0
stdlib/test01.expr → stdlib/regression/test01.expr
View file