Fixed the "end of stream" in the Ligodity parser. Started replacing

new error reporting in ligodity.ml.

src/parser/ligodity.ml

@@ -3,7 +3,7 @@ open Parser_ligodity
 module Parser = Parser_ligodity.Parser
 module AST = Parser_ligodity.AST
 
-let parse_file (source: string) : AST.t result =  
+let parse_file (source: string) : AST.t result =
   (* let pp_input =
    *   let prefix = Filename.(source |> basename |> remove_extension)
    *   and suffix = ".pp.ligo"
@@ -50,7 +50,7 @@ let parse_file (source: string) : AST.t result =
   ok raw
 
 let parse_string (s:string) : AST.t result =
-  
+
   let lexbuf = Lexing.from_string s in
   let read = Lexer.get_token in
   specific_try (function
@@ -94,5 +94,5 @@ let parse_expression (s:string) : AST.expr result =
               start.pos_fname s
           in
           simple_error str
-    ) @@ (fun () -> Parser.expr read lexbuf) >>? fun raw ->
+    ) @@ (fun () -> Parser.interactive_expr read lexbuf) >>? fun raw ->
   ok raw

src/parser/ligodity/Parser.mly

@@ -47,9 +47,9 @@ let rec mk_field_path (rank, tail) =
 
 (* Entry points *)
 
-%start program expr
+%start program interactive_expr
 %type <AST.t> program
-%type <AST.expr> expr
+%type <AST.expr> interactive_expr
 
 %%
 
@@ -285,7 +285,7 @@ entry_binding:
     {bindings = pattern :: hd :: tl; lhs_type=$3; eq=$4; let_rhs}
   }
   | ident type_annotation? eq fun_expr(expr) {
-    let pattern = PVar $1 in	    
+    let pattern = PVar $1 in
     {bindings = [pattern]; lhs_type=$2; eq=$3; let_rhs=$4} }
 
 (* Top-level non-recursive definitions *)
@@ -382,6 +382,9 @@ tail:
 
 (* Expressions *)
 
+interactive_expr:
+  expr EOF                                                       { $1 }
+
 expr:
   base_cond__open(expr)                                    {       $1 }
 | reg(match_expr(base_cond))                               { ECase $1 }
@@ -468,7 +471,7 @@ fun_expr(right_expr):
     } in
     EFun { region=$1.region; value=f }
   }
-	 
+
 disj_expr_level:
   reg(disj_expr)                          { ELogic (BoolExpr (Or $1)) }
 | conj_expr_level                                                { $1 }

src/simplify/ligodity.ml

@@ -20,13 +20,48 @@ let get_value : 'a Raw.reg -> 'a = fun x -> x.value
 module Errors = struct
   let wrong_pattern expected_name actual =
     let title () = "wrong pattern" in
-    let message () = Format.asprintf "expected a %s, got something else" expected_name in
+    let message () = "" in
     let data = [
+      ("expected", fun () -> expected_name);
       ("actual_loc" , fun () -> Format.asprintf "%a" Location.pp_lift @@ Raw.region_of_pattern actual)
     ] in
     error ~data title message
 
+  let multiple_patterns construct (patterns: Raw.pattern list) =
+    let title () = "multiple patterns" in
+    let message () =
+      Format.asprintf "multiple patterns in \"%s\" are not supported yet" construct in
+    let patterns_loc =
+      List.fold_left (fun a p -> Region.cover a (Raw.region_of_pattern p))
+        Region.min patterns in
+    let data = [
+      ("patterns_loc", fun () -> Format.asprintf "%a" Location.pp_lift @@ patterns_loc)
+    ] in
+    error ~data title message
+
+  let unknown_predefined_type name =
+    let title () = "type constants" in
+    let message () =
+      Format.asprintf "unknown predefined type \"%s\"" name.Region.value in
+    let data = [
+      ("typename_loc",
+       fun () -> Format.asprintf "%a" Location.pp_lift @@ name.Region.region)
+    ] in
+    error ~data title message
+
+  let unsupported_arith_op expr =
+    let title () = "arithmetic expressions" in
+    let message () =
+      Format.asprintf "this arithmetic operator is not supported yet" in
+    let expr_loc = Raw.region_of_expr expr in
+    let data = [
+      ("expr_loc",
+       fun () -> Format.asprintf "%a" Location.pp_lift @@ expr_loc)
+    ] in
+    error ~data title message
+
 end
+
 open Errors
 
 open Operators.Simplify.Ligodity
@@ -48,7 +83,7 @@ let rec pattern_to_typed_var : Raw.pattern -> _ = fun p ->
       ok (v , Some tp.type_expr)
     )
   | Raw.PVar v -> ok (v , None)
-  | _ -> fail @@ wrong_pattern "var/typed" p
+  | _ -> fail @@ wrong_pattern "typed variable" p
 
 let rec expr_to_typed_expr : Raw.expr -> _ = fun e ->
   match e with
@@ -59,7 +94,7 @@ let rec expr_to_typed_expr : Raw.expr -> _ = fun e ->
 let patterns_to_var : Raw.pattern list -> _ = fun ps ->
   match ps with
   | [ pattern ] -> pattern_to_var pattern
-  | _ -> fail (simple_error "multiple patterns not supported on lets yet")
+  | _ -> fail @@ multiple_patterns "let" ps
 
 let rec simpl_type_expression : Raw.type_expr -> type_expression result = fun te ->
   trace (simple_info "simplifying this type expression...") @@
@@ -83,7 +118,7 @@ let rec simpl_type_expression : Raw.type_expr -> type_expression result = fun te
       let (name, tuple) = x.value in
       let lst = npseq_to_list tuple.value.inside in
       let%bind cst =
-        trace_option (simple_error "unrecognized type constants") @@
+        trace_option (unknown_predefined_type name) @@
         List.assoc_opt name.value type_constants
       in
       let%bind lst' = bind_map_list simpl_type_expression lst in
@@ -259,7 +294,8 @@ let rec simpl_expression :
       let n = Z.to_int @@ snd @@ n in
       return @@ e_literal ~loc (Literal_tez n)
     )
-  | EArith _ -> simple_fail "arith: not supported yet"
+  | EArith _ as e ->
+       fail @@ (unsupported_arith_op e)
   | EString (String s) -> (
       let (s , loc) = r_split s in
       let s' =
@@ -268,7 +304,8 @@ let rec simpl_expression :
       in
       return @@ e_literal ~loc (Literal_string s')
     )
-  | EString _ -> simple_fail "string: not supported yet"
+  | EString (Cat _) ->
+      simple_fail "string: not supported yet"
   | ELogic l -> simpl_logic_expression l
   | EList l -> simpl_list_expression l
   | ECase c -> (