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

Browse source
This commit is contained in:
Dmitry Boulytchev 2020-01-04 22:28:57 +03:00
parent 6322ee6bed
commit 8658f1343b
1 changed files with 14 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

26
src/Language.ml
View file

@ -11,6 +11,8 @@ open Combinators
exception Semantic_error of string exception Semantic_error of string
let report_error str = raise (Semantic_error str)
module Loc = module Loc =
struct struct
@type t = int * int with show, html @type t = int * int with show, html
@ -159,7 +161,7 @@ module State =
let undefined x = failwith (Printf.sprintf "Undefined variable: %s" x) let undefined x = failwith (Printf.sprintf "Undefined variable: %s" x)
(* Create a state from bindings list *) (* Create a state from bindings list *)
let from_list l = fun x -> try List.assoc x l with Not_found -> invalid_arg (Printf.sprintf "undefined variable %s" x) let from_list l = fun x -> try List.assoc x l with Not_found -> report_error (Printf.sprintf "undefined variable %s" x)
(* Bind a variable to a value in a state *) (* Bind a variable to a value in a state *)
let bind x v s = fun y -> if x = y then v else s y let bind x v s = fun y -> if x = y then v else s y
@ -178,16 +180,16 @@ module State =
*) *)
let update x v s = let update x v s =
let rec inner = function let rec inner = function
| I -> invalid_arg "uninitialized state" | I -> report_error "uninitialized state"
| G (scope, s) -> | G (scope, s) ->
if is_var x scope if is_var x scope
then G (scope, bind x v s) then G (scope, bind x v s)
else invalid_arg (Printf.sprintf "name %s is undefined or does not designate a variable" x) else report_error (Printf.sprintf "name %s is undefined or does not designate a variable" x)
| L (scope, s, enclosing) -> | L (scope, s, enclosing) ->
if in_scope x scope if in_scope x scope
then if is_var x scope then if is_var x scope
then L (scope, bind x v s, enclosing) then L (scope, bind x v s, enclosing)
else invalid_arg (Printf.sprintf "name %s does not designate a variable" x) else report_error (Printf.sprintf "name %s does not designate a variable" x)
else L (scope, s, inner enclosing) else L (scope, s, inner enclosing)
in in
inner s inner s
@ -195,14 +197,14 @@ module State =
(* Evals a variable in a state w.r.t. a scope *) (* Evals a variable in a state w.r.t. a scope *)
let rec eval s x = let rec eval s x =
match s with match s with
| I -> invalid_arg "uninitialized state" | I -> report_error "uninitialized state"
| G (_, s) -> s x | G (_, s) -> s x
| L (scope, s, enclosing) -> if in_scope x scope then s x else eval enclosing x | L (scope, s, enclosing) -> if in_scope x scope then s x else eval enclosing x
(* Drops a scope *) (* Drops a scope *)
let leave st st' = let leave st st' =
let rec get = function let rec get = function
| I -> invalid_arg "uninitialized state" | I -> report_error "uninitialized state"
| G _ as st -> st | G _ as st -> st
| L (_, _, e) -> get e | L (_, _, e) -> get e
in in
@ -217,7 +219,7 @@ module State =
(* Creates a new scope, based on a given state *) (* Creates a new scope, based on a given state *)
let rec enter st xs = let rec enter st xs =
match st with match st with
| I -> invalid_arg "uninitialized state" | I -> report_error "uninitialized state"
| G _ -> L (xs, undefined, st) | G _ -> L (xs, undefined, st)
| L (_, _, e) -> enter e xs | L (_, _, e) -> enter e xs
@ -357,7 +359,7 @@ module Expr =
match x with match x with
| Value.Var (Value.Global x) -> State.update x v st | Value.Var (Value.Global x) -> State.update x v st
| Value.Elem (x, i) -> Value.update_elem x i v; st | Value.Elem (x, i) -> Value.update_elem x i v; st
| _ -> invalid_arg (Printf.sprintf "invalid value %s in update" @@ show(Value.t) (fun _ -> "<expr>") (fun _ -> "<state>") x) | _ -> report_error (Printf.sprintf "invalid value %s in update" @@ show(Value.t) (fun _ -> "<expr>") (fun _ -> "<state>") x)
(* Expression evaluator (* Expression evaluator
@ -481,7 +483,7 @@ module Expr =
let st'', i', o', vs'' = eval (st', i, o, []) Skip body in let st'', i', o', vs'' = eval (st', i, o, []) Skip body in
closure.(0) <- st''; closure.(0) <- st'';
(State.leave st'' st, i', o', match vs'' with [v] -> v::vs' | _ -> Value.Empty :: vs') (State.leave st'' st, i', o', match vs'' with [v] -> v::vs' | _ -> Value.Empty :: vs')
| _ -> invalid_arg (Printf.sprintf "callee did not evaluate to a function: %s" (show(Value.t) (fun _ -> "<expr>") (fun _ -> "<state>") f)) | _ -> report_error (Printf.sprintf "callee did not evaluate to a function: %s" (show(Value.t) (fun _ -> "<expr>") (fun _ -> "<state>") f))
))])) ))]))
| Leave -> eval (State.drop st, i, o, vs) Skip k | Leave -> eval (State.drop st, i, o, vs) Skip k
@ -680,7 +682,7 @@ module Expr =
| `Len , _ -> Length b | `Len , _ -> Length b
| `Str , _ -> StringVal b | `Str , _ -> StringVal b
| `Post (f, args), _ -> Call (Var f, b :: match args with None -> [] | Some args -> args) | `Post (f, args), _ -> Call (Var f, b :: match args with None -> [] | Some args -> args)
| `Call args , _ -> (match b with Sexp _ -> invalid_arg "retry!" | _ -> Call (b, args)) | `Call args , _ -> (match b with Sexp _ -> invalid_arg "retry!" | _ -> Call (b, args))
in in
ignore atr (s res) ignore atr (s res)
} }
@ -944,7 +946,7 @@ module Interface =
(ostap (interface -EOF)) (ostap (interface -EOF))
with with
| `Ok intfs -> Some intfs | `Ok intfs -> Some intfs
| `Fail er -> invalid_arg (Printf.sprintf "malformed interface file '%s': %s" fname er) | `Fail er -> report_error (Printf.sprintf "malformed interface file '%s': %s" fname er)
) )
with Sys_error _ -> None with Sys_error _ -> None
@ -959,7 +961,7 @@ module Interface =
in in
match inner paths with match inner paths with
| Some (path, intfs) -> path, intfs | Some (path, intfs) -> path, intfs
| None -> invalid_arg (Printf.sprintf "could not find an interface file for import '%s'" import) | None -> report_error (Printf.sprintf "could not find an interface file for import '%s'" import)
end end