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

Better error reporting for infixes

Browse source
This commit is contained in:
Dmitry Boulytchev 2020-01-14 05:36:03 +03:00
parent a12f9337e9
commit faca5c6e0e
3 changed files with 28 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

6
src/Driver.ml
View file

@ -110,7 +110,7 @@ class options args =
end
let main =
(* try *)
try
let cmd = new options Sys.argv in
match (try parse cmd with Language.Semantic_error msg -> `Fail msg) with
| `Ok prog ->
@ -119,8 +119,6 @@ let main =
| `Default | `Compile ->
ignore @@ X86.build cmd prog
| _ ->
(* Printf.printf "Program:\n%s\n" (GT.show(Language.Expr.t) prog);*)
(*Format.printf "Program\n%s\n%!" (HTML.toHTML ((GT.html(Language.Expr.t)) prog));*)
let rec read acc =
try
let r = read_int () in
@ -137,5 +135,5 @@ let main =
List.iter (fun i -> Printf.printf "%d\n" i) output
)
| `Fail er -> Printf.eprintf "Error: %s\n" er
(*with Language.Semantic_error msg -> Printf.printf "Error: %s\n" msg *)
with Language.Semantic_error msg -> Printf.printf "Error: %s\n" msg

30
src/Language.ml
View file

@ -9,17 +9,33 @@ open GT
open Ostap
open Combinators
module Subst =
struct
module H = Hashtbl.Make (struct type t = string let hash = Hashtbl.hash let equal = (=) end)
let tab = (H.create 1024 : string H.t)
let attach infix op = H.add tab infix op
let subst id = match H.find_opt tab id with None -> id | Some op -> op
end
let infix_name infix =
let b = Buffer.create 64 in
Buffer.add_string b "i__Infix_";
Seq.iter (fun c -> Buffer.add_string b (string_of_int @@ Char.code c)) @@ String.to_seq infix;
Buffer.contents b
let s = Buffer.contents b in
Subst.attach s ("operator " ^ infix);
s
let sys_infix_name infix =
let b = Buffer.create 64 in
Buffer.add_string b "s__Infix_";
Seq.iter (fun c -> Buffer.add_string b (string_of_int @@ Char.code c)) @@ String.to_seq infix;
Buffer.contents b
let s = Buffer.contents b in
Subst.attach s ("operator " ^ infix);
s
exception Semantic_error of string
@ -180,10 +196,10 @@ module State =
(* Undefined state *)
let undefined x =
report_error ~loc:(Loc.get x) (Printf.sprintf "undefined name \"%s\"" x)
report_error ~loc:(Loc.get x) (Printf.sprintf "undefined name \"%s\"" (Subst.subst x))
(* Create a state from bindings list *)
let from_list l = fun x -> try List.assoc x l with Not_found -> report_error ~loc:(Loc.get x) (Printf.sprintf "undefined name \"%s\"" x)
let from_list l = fun x -> try List.assoc x l with Not_found -> report_error ~loc:(Loc.get x) (Printf.sprintf "undefined name \"%s\"" (Subst.subst x))
(* Bind a variable to a value in a state *)
let bind x v s = fun y -> if x = y then v else s y
@ -206,12 +222,12 @@ module State =
| G (scope, s) ->
if is_var x scope
then G (scope, bind x v s)
else report_error ~loc:(Loc.get x) (Printf.sprintf "name \"%s\" is undefined or does not designate a variable" x)
else report_error ~loc:(Loc.get x) (Printf.sprintf "name \"%s\" is undefined or does not designate a variable" (Subst.subst 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 ~loc:(Loc.get x) (Printf.sprintf "name \"%s\" does not designate a variable" x)
else report_error ~loc:(Loc.get x) (Printf.sprintf "name \"%s\" does not designate a variable" (Subst.subst x))
else L (scope, s, inner enclosing)
in
inner s
@ -443,7 +459,7 @@ module Expr =
([], body, [])
(List.rev @@
List.map (function
| (name, (`Extern, _)) -> report_error (Printf.sprintf "external names (\"%s\") not supported in evaluation" name)
| (name, (`Extern, _)) -> report_error (Printf.sprintf "external names (\"%s\") not supported in evaluation" (Subst.subst name))
| x -> x
)
defs)

4
src/SM.ml
View file

@ -247,7 +247,7 @@ let scope_label i s = label s ^ "_" ^ string_of_int i
let check_name_and_add names name mut =
if List.exists (fun (n, _) -> n = name) names
then report_error ~loc:(Loc.get name) (Printf.sprintf "name \"%s\" is already defined in the scope" name)
then report_error ~loc:(Loc.get name) (Printf.sprintf "name \"%s\" is already defined in the scope" (Subst.subst name))
else (name, mut) :: names
;;
@ -543,7 +543,7 @@ object (self : 'self)
match m with
| `Local -> ()
| _ ->
report_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" (Subst.subst name))
method add_name (name : string) (m : [`Local | `Extern | `Public | `PublicExtern]) (mut : bool) = {<
decls = (name, m, false) :: decls;