Refactoring of the AST and simplfier of PascaLIGO.

Some weeks ago, anonymous functions as expressions were added to
PascaLIGO, unfortunately in a manner that allowed in theory for
contexts in which a named function was found when an anonymous was
expected, and vice-versa. That explains that the simplifier had two new possible errors:

   * unexpected_anonymous_function
     ("you provided a function declaration without name")
   * unexpected_named_function

I changed the AST and the parser so that function expressions
correspond to anonymous functions (without block) and function
declarations correspond to named functions.

I also removed a error in the simplifier, which was unused:

   * bad_bytes
     ("you provided a function expression with a name (remove it)")

src/passes/1-parser/pascaligo/AST.ml

@@ -196,17 +196,22 @@ and type_tuple = (type_expr, comma) nsepseq par reg
 
 and fun_expr = {
   kwd_function : kwd_function;
-  name         : variable option;
+  param        : parameters;
+  colon        : colon;
+  ret_type     : type_expr;
+  kwd_is       : kwd_is;
+  return       : expr
+}
+
+and fun_decl = {
+  kwd_function : kwd_function;
+  fun_name     : variable;
   param        : parameters;
   colon        : colon;
   ret_type     : type_expr;
   kwd_is       : kwd_is;
   block_with   : (block reg * kwd_with) option;
-  return       : expr
+  return       : expr;
-}
-
-and fun_decl = {
-  fun_expr   : fun_expr reg;
   terminator   : semi option
 }
 

src/passes/1-parser/pascaligo/Parser.mly

@@ -226,50 +226,54 @@ field_decl:
     in {region; value} }
 
 fun_expr:
-  "function" fun_name? parameters ":" type_expr "is"
+  "function" parameters ":" type_expr "is" expr {
+    let stop   = expr_to_region $6 in
+    let region = cover $1 stop
+    and value  = {kwd_function = $1;
+                  param        = $2;
+                  colon        = $3;
+                  ret_type     = $4;
+                  kwd_is       = $5;
+                  return       = $6}
+    in {region; value} }
+
+(* Function declarations *)
+
+open_fun_decl:
+  "function" fun_name parameters ":" type_expr "is"
      block
   "with" expr {
-    let ()     = SyntaxError.check_reserved_name_opt $2 in
+    let fun_name = SyntaxError.check_reserved_name $2 in
     let stop     = expr_to_region $9 in
     let region   = cover $1 stop
     and value    = {kwd_function = $1;
-                  name         = $2;
+                    fun_name;
                     param        = $3;
                     colon        = $4;
                     ret_type     = $5;
                     kwd_is       = $6;
                     block_with   = Some ($7, $8);
-                  return       = $9}
+                    return       = $9;
+                    terminator   = None}
     in {region; value} }
-| "function" fun_name? parameters ":" type_expr "is" expr {
+| "function" fun_name parameters ":" type_expr "is" expr {
-    let ()     = SyntaxError.check_reserved_name_opt $2 in
+    let fun_name = SyntaxError.check_reserved_name $2 in
     let stop     = expr_to_region $7 in
     let region   = cover $1 stop
     and value    = {kwd_function = $1;
-                  name         = $2;
+                    fun_name;
                     param        = $3;
                     colon        = $4;
                     ret_type     = $5;
                     kwd_is       = $6;
                     block_with   = None;
-                  return       = $7}
+                    return       = $7;
+                    terminator   = None}
     in {region; value} }
 
-
-(* Function declarations *)
-
 fun_decl:
-  open_fun_decl { $1 }
+  open_fun_decl ";"? {
-| fun_expr ";"  {
+    {$1 with value = {$1.value with terminator=$2}} }
-    let region = cover $1.region $2
-    and value  = {fun_expr=$1; terminator = Some $2}
-    in {region; value} }
-
-open_fun_decl:
-  fun_expr {
-    let region = $1.region
-    and value  = {fun_expr=$1; terminator=None}
-    in {region; value} }
 
 parameters:
   par(nsepseq(param_decl,";")) {

src/passes/1-parser/pascaligo/ParserLog.ml

@@ -195,13 +195,12 @@ and print_type_tuple state {value; _} =
   print_nsepseq state "," print_type_expr inside;
   print_token state rpar ")"
 
-and print_fun_expr state {value; _} =
+and print_fun_decl state {value; _} =
-  let {kwd_function; name; param; colon;
+  let {kwd_function; fun_name; param; colon;
-       ret_type; kwd_is; block_with; return} = value in
+       ret_type; kwd_is; block_with;
+       return; terminator} = value in
   print_token       state kwd_function "function";
-  (match name with
+  print_var         state fun_name;
-     None -> print_var state (Region.wrap_ghost "#anon")
-   | Some var -> print_var state var);
   print_parameters  state param;
   print_token       state colon ":";
   print_type_expr   state ret_type;
@@ -212,11 +211,17 @@ and print_fun_expr state {value; _} =
      print_block state block;
      print_token state kwd_with "with");
   print_expr state return;
+  print_terminator state terminator
 
-and print_fun_decl state {value; _} =
+and print_fun_expr state {value; _} =
-  let {fun_expr ; terminator;} = value in
+  let {kwd_function; param; colon;
-  print_fun_expr state fun_expr;
+       ret_type; kwd_is; return} : fun_expr = value in
-  print_terminator state terminator;
+  print_token       state kwd_function "function";
+  print_parameters  state param;
+  print_token       state colon ":";
+  print_type_expr   state ret_type;
+  print_token       state kwd_is "is";
+  print_expr        state return
 
 and print_parameters state {value; _} =
   let {lpar; inside; rpar} = value in
@@ -826,7 +831,33 @@ and pp_declaration state = function
     pp_const_decl state value
 | FunDecl {value; region} ->
     pp_loc_node state "FunDecl" region;
-    pp_fun_expr state value.fun_expr.value
+    pp_fun_decl state value
+
+and pp_fun_decl state decl =
+  let () =
+    let state = state#pad 5 0 in
+    pp_ident state decl.fun_name in
+  let () =
+    let state = state#pad 5 1 in
+    pp_node state "<parameters>";
+    pp_parameters state decl.param in
+  let () =
+    let state = state#pad 5 2 in
+    pp_node state "<return type>";
+    pp_type_expr (state#pad 1 0) decl.ret_type in
+  let () =
+    let state = state#pad 5 3 in
+    pp_node state "<body>";
+    let statements =
+      match decl.block_with with
+        Some (block,_) -> block.value.statements
+      | None -> Instr (Skip Region.ghost), [] in
+    pp_statements state statements in
+  let () =
+    let state = state#pad 5 4 in
+    pp_node state "<return>";
+    pp_expr (state#pad 1 0) decl.return
+  in ()
 
 and pp_const_decl state decl =
   pp_ident (state#pad 3 0) decl.name;
@@ -888,32 +919,19 @@ and pp_type_tuple state {value; _} =
   let apply len rank = pp_type_expr (state#pad len rank)
   in List.iteri (List.length components |> apply) components
 
-and pp_fun_expr state decl =
+and pp_fun_expr state (expr: fun_expr) =
   let () =
-    let state = state#pad 5 0 in
+    let state = state#pad 3 0 in
-    match decl.name with
-      None -> pp_ident state (Region.wrap_ghost "#anon")
-    | Some var -> pp_ident state var in
-  let () =
-    let state = state#pad 5 1 in
     pp_node state "<parameters>";
-    pp_parameters state decl.param in
+    pp_parameters state expr.param in
   let () =
-    let state = state#pad 5 2 in
+    let state = state#pad 3 1 in
     pp_node state "<return type>";
-    pp_type_expr (state#pad 1 0) decl.ret_type in
+    pp_type_expr (state#pad 1 0) expr.ret_type in
   let () =
-    let state = state#pad 5 3 in
+    let state = state#pad 3 2 in
-    pp_node state "<body>";
-    let statements =
-      match decl.block_with with
-        Some (block,_) -> block.value.statements
-      | None -> Instr (Skip Region.ghost), [] in
-    pp_statements state statements in
-  let () =
-    let state = state#pad 5 4 in
     pp_node state "<return>";
-    pp_expr (state#pad 1 0) decl.return
+    pp_expr (state#pad 1 0) expr.return
   in ()
 
 and pp_parameters state {value; _} =
@@ -1307,7 +1325,7 @@ and pp_data_decl state = function
     pp_var_decl state value
 | LocalFun {value; region} ->
     pp_loc_node state "LocalFun" region;
-    pp_fun_expr state value.fun_expr.value
+    pp_fun_decl state value
 
 and pp_var_decl state decl =
   pp_ident     (state#pad 3 0) decl.name;

src/passes/2-simplify/pascaligo.ml

@@ -77,16 +77,6 @@ module Errors = struct
     ] in
     error ~data title message
 
-  let bad_bytes loc str =
-    let title () = "bad bytes string" in
-    let message () =
-      Format.asprintf "bytes string contained non-hexadecimal chars" in
-    let data = [
-      ("location", fun () -> Format.asprintf "%a" Location.pp loc) ;
-      ("bytes", fun () -> str) ;
-    ] in
-    error ~data title message
-
   let corner_case ~loc message =
     let title () = "corner case" in
     let content () = "We don't have a good error message for this case. \
@@ -170,22 +160,6 @@ module Errors = struct
     ] in
     error ~data title message
 
-  let unexpected_anonymous_function loc =
-    let title () = "unexpected anonymous function" in
-    let message () = "you provided a function declaration without name" in
-    let data = [
-        ("location" , fun () -> Format.asprintf "%a" Location.pp @@ loc)
-      ] in
-    error ~data title message
-
-  let unexpected_named_function loc =
-    let title () = "unexpected named function" in
-    let message () = "you provided a function expression with a name (remove it)" in
-    let data = [
-        ("location" , fun () -> Format.asprintf "%a" Location.pp @@ loc)
-      ] in
-    error ~data title message
-
   (* Logging *)
 
   let simplifying_instruction t =
@@ -205,20 +179,21 @@ open Operators.Simplify.Pascaligo
 
 let r_split = Location.r_split
 
-(*
+(* Statements can't be simplified in isolation. [a ; b ; c] can get
-  Statements can't be simplified in isolation. `a ; b ; c` can get simplified either
+   simplified either as [let x = expr in (b ; c)] if [a] is a [const x
-  as `let x = expr in (b ; c)` if `a` is a ` const x = expr` declaration or as
+   = expr] declaration or as [sequence(a, sequence(b, c))] for
-  `sequence(a , sequence(b , c))` for everything else.
+   everything else.  Because of this, simplifying sequences depend on
-  Because of this, simplifying sequences depend on their contents. To avoid peeking in
+   their contents. To avoid peeking in their contents, we instead
-  their contents, we instead simplify sequences elements as functions from their next
+   simplify sequences elements as functions from their next elements
-  elements to the actual result.
+   to the actual result.
 
-  For `return_let_in`, if there is no follow-up element, an error is triggered, as
+   For [return_let_in], if there is no follow-up element, an error is
-  you can't have `let x = expr in ...` with no `...`. A cleaner option might be to add
+   triggered, as you can't have [let x = expr in ...] with no [...]. A
-  a `unit` instead of erroring.
+   cleaner option might be to add a [unit] instead of failing.
+
+   [return_statement] is used for non-let-in statements.
+ *)
 
-  `return_statement` is used for non-let_in statements.
-*)
 let return_let_in ?loc binder rhs = ok @@ fun expr'_opt ->
   match expr'_opt with
   | None -> fail @@ corner_case ~loc:__LOC__ "missing return"
@@ -246,7 +221,8 @@ let rec simpl_type_expression (t:Raw.type_expr) : type_expression result =
   | TApp x ->
       let (name, tuple) = x.value in
       let lst = npseq_to_list tuple.value.inside in
-      let%bind lst = bind_list @@ List.map simpl_type_expression lst in (** TODO: fix constant and operator*)
+      let%bind lst =
+        bind_list @@ List.map simpl_type_expression lst in (** TODO: fix constant and operator*)
       let%bind cst =
         trace (unknown_predefined_type name) @@
         type_operators name.value in
@@ -481,13 +457,10 @@ let rec simpl_expression (t:Raw.expr) : expr result =
       let%bind index = simpl_expression lu.index.value.inside in
       return @@ e_look_up ~loc path index
     )
-  | EFun f -> (
+  | EFun f ->
     let (f , loc) = r_split f in
-    let%bind ((name_opt , _ty_opt) , f') = simpl_fun_expression ~loc f in
+    let%bind (_ty_opt, f') = simpl_fun_expression ~loc f
-    match name_opt with
+    in return @@ f'
-    | None -> return @@ f'
-    | Some _ -> fail @@ unexpected_named_function loc
-  )
 
 and simpl_logic_expression (t:Raw.logic_expr) : expression result =
   let return x = ok x in
@@ -589,9 +562,8 @@ and simpl_data_declaration : Raw.data_decl -> _ result = fun t ->
       return_let_in ~loc (Var.of_name name , Some t) expression
   | LocalFun f  ->
       let (f , loc) = r_split f in
-      let%bind ((name_opt , ty_opt) , e) = simpl_fun_expression ~loc f.fun_expr.value in
+      let%bind (binder, expr) = simpl_fun_decl ~loc f
-      let%bind name = trace_option (unexpected_anonymous_function loc) name_opt in
+      in return_let_in ~loc binder expr
-      return_let_in ~loc (name , ty_opt) e
 
 and simpl_param : Raw.param_decl -> (expression_variable * type_expression) result =
   fun t ->
@@ -607,11 +579,11 @@ and simpl_param : Raw.param_decl -> (expression_variable * type_expression) resu
       let%bind type_expression = simpl_type_expression c.param_type in
       ok (type_name , type_expression)
 
-and simpl_fun_expression :
+and simpl_fun_decl :
-  loc:_ -> Raw.fun_expr -> ((expression_variable option * type_expression option) * expression) result =
+  loc:_ -> Raw.fun_decl -> ((expression_variable * type_expression option) * expression) result =
   fun ~loc x ->
   let open! Raw in
-  let {name;param;ret_type;block_with;return} : fun_expr = x in
+  let {fun_name;param;ret_type;block_with;return} : fun_decl = x in
   let statements =
     match block_with with
     | Some (block,_) -> npseq_to_list block.value.statements
@@ -620,7 +592,6 @@ and simpl_fun_expression :
   (match param.value.inside with
      a, [] -> (
        let%bind input = simpl_param a in
-       let name = Option.map (fun (x : _ reg) -> Var.of_name x.value) name in
        let (binder , input_type) = input in
        let%bind instructions = bind_list
          @@ List.map simpl_statement
@@ -633,19 +604,22 @@ and simpl_fun_expression :
          bind_fold_right_list aux result body in
        let expression : expression = e_lambda ~loc binder (Some input_type)
            (Some output_type) result in
-       let type_annotation = Some (make_t @@ T_arrow (input_type, output_type)) in
+       let type_annotation =
-       ok ((name , type_annotation) , expression)
+         Some (make_t @@ T_arrow (input_type, output_type)) in
+       ok ((Var.of_name fun_name.value, type_annotation), expression)
      )
    | lst -> (
        let lst = npseq_to_list lst in
-       let arguments_name = Var.of_name "arguments" in (* TODO wrong, should be fresh? *)
+       (* TODO wrong, should be fresh? *)
+       let arguments_name = Var.of_name "arguments" in
        let%bind params = bind_map_list simpl_param lst in
        let (binder , input_type) =
          let type_expression = T_tuple (List.map snd params) in
          (arguments_name , type_expression) in
        let%bind tpl_declarations =
          let aux = fun i x ->
-           let expr = e_accessor (e_variable arguments_name) [Access_tuple i] in
+           let expr =
+             e_accessor (e_variable arguments_name) [Access_tuple i] in
            let type_variable = Some (snd x) in
            let ass = return_let_in (fst x , type_variable) expr in
            ass
@@ -663,34 +637,91 @@ and simpl_fun_expression :
        let expression =
          e_lambda ~loc binder (Some (make_t @@ input_type)) (Some output_type) result in
        let type_annotation = Some (make_t @@ T_arrow (make_t input_type, output_type)) in
-       let name = Option.map (fun (x : _ reg) -> Var.of_name x.value) name in
+       ok ((Var.of_name fun_name.value, type_annotation), expression)
-       ok ((name , type_annotation) , expression)
      )
   )
+
+and simpl_fun_expression :
+  loc:_ -> Raw.fun_expr -> (type_expression option * expression) result =
+  fun ~loc x ->
+  let open! Raw in
+  let {param;ret_type;return;_} : fun_expr = x in
+  let statements = [] in
+  (match param.value.inside with
+     a, [] -> (
+       let%bind input = simpl_param a in
+       let (binder , input_type) = input in
+       let%bind instructions = bind_list
+         @@ List.map simpl_statement
+         @@ statements in
+       let%bind result = simpl_expression return in
+       let%bind output_type = simpl_type_expression ret_type in
+       let body = instructions in
+       let%bind result =
+         let aux prec cur = cur (Some prec) in
+         bind_fold_right_list aux result body in
+       let expression : expression = e_lambda ~loc binder (Some input_type)
+           (Some output_type) result in
+       let type_annotation =
+         Some (make_t @@ T_arrow (input_type, output_type)) in
+       ok (type_annotation, expression)
+     )
+   | lst -> (
+       let lst = npseq_to_list lst in
+       (* TODO wrong, should be fresh? *)
+       let arguments_name = Var.of_name "arguments" in
+       let%bind params = bind_map_list simpl_param lst in
+       let (binder , input_type) =
+         let type_expression = T_tuple (List.map snd params) in
+         (arguments_name , type_expression) in
+       let%bind tpl_declarations =
+         let aux = fun i x ->
+           let expr =
+             e_accessor (e_variable arguments_name) [Access_tuple i] in
+           let type_variable = Some (snd x) in
+           let ass = return_let_in (fst x , type_variable) expr in
+           ass
+         in
+         bind_list @@ List.mapi aux params in
+       let%bind instructions = bind_list
+         @@ List.map simpl_statement
+         @@ statements in
+       let%bind result = simpl_expression return in
+       let%bind output_type = simpl_type_expression ret_type in
+       let body = tpl_declarations @ instructions in
+       let%bind result =
+         let aux prec cur = cur (Some prec) in
+         bind_fold_right_list aux result body in
+       let expression =
+         e_lambda ~loc binder (Some (make_t @@ input_type)) (Some output_type) result in
+       let type_annotation = Some (make_t @@ T_arrow (make_t input_type, output_type)) in
+       ok (type_annotation, expression)
+     )
+  )
+
 and simpl_declaration : Raw.declaration -> declaration Location.wrap result =
   fun t ->
   let open! Raw in
   match t with
-  | TypeDecl x -> (
+  | TypeDecl x ->
-      let (x , loc) = r_split x in
+      let decl, loc = r_split x in
-      let {name;type_expr} : Raw.type_decl = x in
+      let {name;type_expr} : Raw.type_decl = decl in
       let%bind type_expression = simpl_type_expression type_expr in
-      ok @@ Location.wrap ~loc (Declaration_type (Var.of_name name.value , type_expression))
+      ok @@ Location.wrap ~loc (Declaration_type
-    )
+                                 (Var.of_name name.value, type_expression))
+
   | ConstDecl x ->
       let simpl_const_decl = fun {name;const_type;init} ->
         let%bind expression = simpl_expression init in
         let%bind t = simpl_type_expression const_type in
         let type_annotation = Some t in
-        ok @@ Declaration_constant (Var.of_name name.value , type_annotation , expression)
+        ok @@ Declaration_constant
-      in
+               (Var.of_name name.value, type_annotation, expression)
-      bind_map_location simpl_const_decl (Location.lift_region x)
+      in bind_map_location simpl_const_decl (Location.lift_region x)
-  | FunDecl x -> (
+  | FunDecl x ->
-      let (x , loc) = r_split x in
+      let decl, loc = r_split x in
-      let%bind ((name_opt , ty_opt) , expr) = simpl_fun_expression ~loc x.fun_expr.value in
+      let%bind ((name, ty_opt), expr) = simpl_fun_decl ~loc decl in
-      let%bind name = trace_option (unexpected_anonymous_function loc) name_opt in
+      ok @@ Location.wrap ~loc (Declaration_constant (name, ty_opt, expr))
-      ok @@ Location.wrap ~loc (Declaration_constant (name , ty_opt , expr))
-    )
 
 and simpl_statement : Raw.statement -> (_ -> expression result) result =
   fun s ->

src/passes/2-simplify/pascaligo.mli

@@ -6,16 +6,10 @@ open Ast_simplified
 module Raw = Parser.Pascaligo.AST
 module SMap = Map.String
 
-module Errors :
+(** Convert a concrete PascaLIGO expression AST to the simplified
-  sig
+    expression AST used by the compiler. *)
-    val bad_bytes : Location.t -> string -> unit -> error
-  end
-
-
-(** Convert a concrete PascaLIGO expression AST to the simplified expression AST
-    used by the compiler. *)
 val simpl_expression : Raw.expr -> expr result
 
-(** Convert a concrete PascaLIGO program AST to the simplified program AST used
+(** Convert a concrete PascaLIGO program AST to the simplified program
-    by the compiler. *)
+    AST used by the compiler. *)
 val simpl_program : Raw.ast -> program result

vendors/UnionFind/UnionFind.install

@@ -0,0 +1,36 @@
+lib: [
+  "_build/install/default/lib/UnionFind/META"
+  "_build/install/default/lib/UnionFind/Partition.cmi"
+  "_build/install/default/lib/UnionFind/Partition.cmti"
+  "_build/install/default/lib/UnionFind/Partition.mli"
+  "_build/install/default/lib/UnionFind/Partition0.cmi"
+  "_build/install/default/lib/UnionFind/Partition0.cmt"
+  "_build/install/default/lib/UnionFind/Partition0.cmx"
+  "_build/install/default/lib/UnionFind/Partition0.ml"
+  "_build/install/default/lib/UnionFind/Partition1.cmi"
+  "_build/install/default/lib/UnionFind/Partition1.cmt"
+  "_build/install/default/lib/UnionFind/Partition1.cmx"
+  "_build/install/default/lib/UnionFind/Partition1.ml"
+  "_build/install/default/lib/UnionFind/Partition2.cmi"
+  "_build/install/default/lib/UnionFind/Partition2.cmt"
+  "_build/install/default/lib/UnionFind/Partition2.cmx"
+  "_build/install/default/lib/UnionFind/Partition2.ml"
+  "_build/install/default/lib/UnionFind/Partition3.cmi"
+  "_build/install/default/lib/UnionFind/Partition3.cmt"
+  "_build/install/default/lib/UnionFind/Partition3.cmx"
+  "_build/install/default/lib/UnionFind/Partition3.ml"
+  "_build/install/default/lib/UnionFind/UnionFind.a"
+  "_build/install/default/lib/UnionFind/UnionFind.cma"
+  "_build/install/default/lib/UnionFind/UnionFind.cmxa"
+  "_build/install/default/lib/UnionFind/UnionFind.cmxs"
+  "_build/install/default/lib/UnionFind/dune-package"
+  "_build/install/default/lib/UnionFind/opam"
+  "_build/install/default/lib/UnionFind/unionFind.cmi"
+  "_build/install/default/lib/UnionFind/unionFind.cmt"
+  "_build/install/default/lib/UnionFind/unionFind.cmx"
+  "_build/install/default/lib/UnionFind/unionFind.ml"
+]
+doc: [
+  "_build/install/default/doc/UnionFind/LICENSE"
+  "_build/install/default/doc/UnionFind/README.md"
+]

vendors/ligo-utils/simple-utils/region.ml

@@ -98,6 +98,8 @@ let make ~(start: Pos.t) ~(stop: Pos.t) =
                   info start_offset stop#line horizontal stop_offset
 
       method compact ?(file=true) ?(offsets=true) mode =
+        if start#is_ghost || stop#is_ghost then "ghost"
+        else
           let prefix    = if file then start#file ^ ":" else ""
           and start_str = start#anonymous ~offsets mode
           and stop_str  = stop#anonymous ~offsets mode in