Merge branch 'feature/ast-cleanup-ocaml-tuples' into 'dev'

AST cleanup + replace OCaml tuples with record in ast_typed

See merge request ligolang/ligo!429

src/passes/6-transpiler/transpiler.ml

@@ -338,7 +338,7 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
                 trace_option (corner_case ~loc:__LOC__ "missing var") @@
                 AST.Environment.get_opt v f.environment in
               match elt.definition with
-              | ED_declaration (f , _) -> (
+              | ED_declaration { expr = f ; free_variables = _ } -> (
                   match f.expression_content with
                   | E_lambda l -> lambda_to_iterator_body f l
                   | _ -> fail @@ unsupported_iterator f.location

src/stages/ast_typed/environment.ml

@@ -6,24 +6,28 @@ let make_element : type_expression -> full_environment -> environment_element_de
   fun type_value source_environment definition -> {type_value ; source_environment ; definition}
 
 let make_element_binder = fun t s -> make_element t s ED_binder
-let make_element_declaration = fun s (ae : expression) ->
+let make_element_declaration = fun s (expr : expression) ->
-  let free_variables = Misc.Free_variables.(expression empty ae) in
+  let free_variables = Misc.Free_variables.(expression empty expr) in
-  make_element (get_type_expression ae) s (ED_declaration (ae , free_variables))
+  make_element (get_type_expression expr) s (ED_declaration {expr ; free_variables})
 
 module Small = struct
   type t = small_environment
 
-  let empty : t = ([] , [])
+  let empty : t = { expression_environment = [] ; type_environment = [] }
 
-  let get_environment : t -> environment = fst
+  (* TODO: generate *)
-  let get_type_environment : t -> type_environment = snd
+  let get_environment : t -> environment = fun { expression_environment ; type_environment=_ } -> expression_environment
-  let map_environment : _ -> t -> t = fun f (a , b) -> (f a , b)
+  (* TODO: generate *)
-  let map_type_environment : _ -> t -> t = fun f (a , b) -> (a , f b)
+  let get_type_environment : t -> type_environment = fun { expression_environment=_ ; type_environment } -> type_environment
+  (* TODO: generate *)
+  let map_environment : _ -> t -> t = fun f { expression_environment ; type_environment } -> { expression_environment = f expression_environment ; type_environment }
+  let map_type_environment : _ -> t -> t = fun f { expression_environment ; type_environment } -> { expression_environment ; type_environment = f type_environment }
 
-  let add : expression_variable -> element -> t -> t = fun k v -> map_environment (fun x -> (k , v) :: x)
+  let add : expression_variable -> element -> t -> t = fun expr_var env_elt -> map_environment (fun x -> {expr_var ; env_elt} :: x)
-  let add_type : type_variable -> type_expression -> t -> t = fun k v -> map_type_environment (fun x -> (k , v) :: x)
+  let add_type : type_variable -> type_expression -> t -> t = fun type_variable type_ -> map_type_environment (fun x -> { type_variable ; type_ } :: x)
-  let get_opt : expression_variable -> t -> element option = fun k x -> List.assoc_opt k (get_environment x)
+  (* TODO: generate : these are now messy, clean them up. *)
-  let get_type_opt : type_variable -> t -> type_expression option = fun k x -> List.assoc_opt k (get_type_environment x)
+  let get_opt : expression_variable -> t -> element option = fun k x -> Option.bind (fun {expr_var=_ ; env_elt} -> Some env_elt) @@ List.find_opt (fun {expr_var ; env_elt=_} -> Var.equal expr_var k) (get_environment x)
+  let get_type_opt : type_variable -> t -> type_expression option = fun k x -> Option.bind (fun {type_variable=_ ; type_} -> Some type_) @@ List.find_opt (fun {type_variable ; type_=_} -> Var.equal type_variable k) (get_type_environment x)
 end
 
 type t = full_environment
@@ -41,11 +45,11 @@ let get_type_opt : type_variable -> t -> type_expression option = fun k x -> Lis
 
 let get_constructor : constructor' -> t -> (type_expression * type_expression) option = fun k x -> (* Left is the constructor, right is the sum type *)
   let aux = fun x ->
-    let aux = fun (_type_name , x) ->
+    let aux = fun {type_variable=_ ; type_} ->
-      match x.type_content with
+      match type_.type_content with
       | T_sum m ->
         (match CMap.find_opt k m with
-           Some km -> Some (km , x)
+           Some km -> Some (km , type_)
          | None -> None)
       | _ -> None
     in
@@ -60,11 +64,11 @@ module PP = struct
 
   let list_sep_scope x = list_sep x (const " | ")
 
-  let environment_element = fun ppf (k , (ele : environment_element)) ->
+  let environment_element = fun ppf {expr_var ; env_elt} ->
-    fprintf ppf "%a -> %a" PP.expression_variable k PP.type_expression ele.type_value
+    fprintf ppf "%a -> %a" PP.expression_variable expr_var PP.type_expression env_elt.type_value
 
-  let type_environment_element = fun ppf (k , tv) ->
+  let type_environment_element = fun ppf {type_variable ; type_} ->
-    fprintf ppf "%a -> %a" PP.type_variable k PP.type_expression tv
+    fprintf ppf "%a -> %a" PP.type_variable type_variable PP.type_expression type_
 
   let environment : _ -> environment -> unit = fun ppf lst ->
     fprintf ppf "E[%a]" (list_sep environment_element (const " , ")) lst

src/stages/ast_typed/misc_smart.ml

@@ -59,7 +59,7 @@ module Captured_variables = struct
           Environment.get_opt name ae.environment in
         match env_element.definition with
         | ED_binder -> ok empty
-        | ED_declaration (_ , _) -> simple_fail "todo"
+        | ED_declaration {expr=_ ; free_variables=_} -> simple_fail "todo"
       )
     | E_application {expr1;expr2} ->
       let%bind lst' = bind_map_list self [ expr1 ; expr2 ] in

src/stages/ast_typed/types.ml

@@ -26,11 +26,12 @@ and declaration =
   *)
 (* | Macro_declaration of macro_declaration *)
 
-and expression =
+and expression = {
-  { expression_content: expression_content
+    expression_content: expression_content ;
-  ; location: Location.t
+    location: Location.t ;
-  ; type_expression: type_expression
+    type_expression: type_expression ;
-  ; environment: full_environment }
+    environment: full_environment ;
+  }
 
 and expression_content =
   (* Base *)
@@ -56,63 +57,98 @@ and expression_content =
   | E_look_up of (expression * expression)
   (* Advanced *)
   | E_loop of loop
-  (*
+  (* | E_ascription of ascription *)
-  | E_ascription of ascription
-  *)
-
-and constant =
-  { cons_name: constant' (* this is at the end because it is huge *)
-  ; arguments: expression list }
 
+and constant = {
+    cons_name: constant' ;
+    arguments: expression list ;
+  }
 
 and application = {expr1: expression; expr2: expression}
 
-and lambda =
+and lambda =  {
-  { binder: expression_variable 
+    binder: expression_variable ;
- (* ; input_type: type_expression option
+    (* input_type: type_expression option ; *)
-  ; output_type: type_expression option *)
+    (* output_type: type_expression option ; *)
-  ; result: expression }
+    result: expression ;
-
-and let_in =
-  { let_binder: expression_variable
-  ; rhs: expression
-  ; let_result: expression
-  ; inline : inline }
-
-and constructor = {constructor: constructor'; element: expression}
-
-and accessor = {expr: expression; label: label}
-
-and update = {record: expression; path: label ; update: expression}
-
-and loop = {condition: expression; body: expression}
-
-and matching_expr = (expression,type_expression) matching_content
-and matching =
-  { matchee: expression
-  ; cases: matching_expr
   }
 
-and ascription = {anno_expr: expression; type_annotation: type_expression}
+and let_in = {
+    let_binder: expression_variable ;
+    rhs: expression ;
+    let_result: expression ;
+    inline : inline ;
+  }
+
+and constructor = {
+    constructor: constructor';
+    element: expression ;
+  }
+
+and accessor = {
+    expr: expression ;
+    label: label ;
+  }
+
+and update = {
+    record: expression ;
+    path: label ;
+    update: expression ;
+  }
+
+and loop = {
+    condition: expression ;
+    body: expression ;
+  }
+
+and matching_expr = (expression, type_expression) matching_content
+and matching = {
+    matchee: expression ;
+    cases: matching_expr ;
+  }
+
+and ascription = {
+    anno_expr: expression ;
+    type_annotation: type_expression ;
+  }
 
 
 and environment_element_definition =
   | ED_binder
-  | ED_declaration of (expression * free_variables)
+  | ED_declaration of environment_element_definition_declaration
+
+and environment_element_definition_declaration = {
+    expr: expression ;
+    free_variables: free_variables ;
+  }
 
 and free_variables = expression_variable list
 
-and environment_element =
+and environment_element = {
-  { type_value: type_expression
+    type_value: type_expression ;
-  ; source_environment: full_environment
+    source_environment: full_environment ;
-  ; definition: environment_element_definition }
+    definition: environment_element_definition ;
+  }
 
-and environment = (expression_variable * environment_element) list
+and environment = environment_binding list
 
-and type_environment = (type_variable * type_expression) list
+and environment_binding = {
+    expr_var: expression_variable ;
+    env_elt: environment_element ;
+  }
+
+and type_environment = type_environment_binding list
+
+and type_environment_binding = {
+    type_variable: type_variable ;
+    type_: type_expression ;
+}
 
 (* SUBST ??? *)
-and small_environment = environment * type_environment
+and small_environment = {
+  expression_environment: environment ;
+  type_environment: type_environment ;
+}
 
 and full_environment = small_environment List.Ne.t
 

src/stages/typesystem/misc.ml

@@ -17,25 +17,25 @@ module Substitution = struct
     let rec rec_yes = true
     and s_environment_element_definition ~substs = function
       | T.ED_binder -> ok @@ T.ED_binder
-      | T.ED_declaration (val_, free_variables) ->
+      | T.ED_declaration T.{expr ; free_variables} ->
-        let%bind val_ = s_expression ~substs  val_ in
+        let%bind expr = s_expression ~substs expr in
         let%bind free_variables = bind_map_list (s_variable ~substs) free_variables in
-        ok @@ T.ED_declaration (val_, free_variables)
+        ok @@ T.ED_declaration {expr ; free_variables}
     and s_environment : T.environment w = fun ~substs env ->
-      bind_map_list (fun (variable, T.{ type_value; source_environment; definition }) ->
+      bind_map_list (fun T.{expr_var=variable ; env_elt={ type_value; source_environment; definition }} ->
           let%bind type_value = s_type_expression ~substs type_value in
           let%bind source_environment = s_full_environment ~substs source_environment in
           let%bind definition = s_environment_element_definition ~substs definition in
-          ok @@ (variable, T.{ type_value; source_environment; definition })) env
+          ok @@ T.{expr_var=variable ; env_elt={ type_value; source_environment; definition }}) env
     and s_type_environment : T.type_environment w = fun ~substs tenv ->
-      bind_map_list (fun (type_variable , type_value) ->
+      bind_map_list (fun T.{type_variable ; type_} ->
         let%bind type_variable = s_type_variable ~substs type_variable in
-        let%bind type_value = s_type_expression ~substs type_value in
+        let%bind type_ = s_type_expression ~substs type_ in
-        ok @@ (type_variable , type_value)) tenv
+        ok @@ T.{type_variable ; type_}) tenv
-    and s_small_environment : T.small_environment w = fun ~substs (environment, type_environment) ->
+    and s_small_environment : T.small_environment w = fun ~substs T.{expression_environment ; type_environment} ->
-      let%bind environment = s_environment ~substs environment in
+      let%bind expression_environment = s_environment ~substs expression_environment in
       let%bind type_environment = s_type_environment ~substs type_environment in
-      ok @@ (environment, type_environment)
+      ok @@ T.{ expression_environment ; type_environment }
     and s_full_environment : T.full_environment w = fun ~substs (a , b) ->
       let%bind a = s_small_environment ~substs a in
       let%bind b = bind_map_list (s_small_environment ~substs) b in