minimal liquidity integration

src/lib_utils/trace.ml

@@ -313,9 +313,16 @@ module Assert = struct
       Option.unopt ~default msg in
     assert_equal ~msg expected actual
 
+  let assert_none ?(msg="not a none") opt = match opt with
+    | None -> ok ()
+    | _ -> simple_fail msg
+
   let assert_list_size ?(msg="lst doesn't have the right size") lst n =
     assert_true ~msg List.(length lst = n)
 
+  let assert_list_empty ?(msg="lst isn't empty") lst =
+    assert_true ~msg List.(length lst = 0)
+
   let assert_list_same_size ?(msg="lists don't have same size") a b =
     assert_true ~msg List.(length a = length b)
 

src/ligo/contracts/basic.mligo

@@ -0,0 +1,3 @@
+type toto = int
+
+let foo : toto = 42 + 127

src/ligo/multifix/generator.ml

@@ -32,6 +32,7 @@ module O = struct
     | `Named of string
     | `Token of token
     | `List of string list_element
+    | `Option of string
   ]
 
   type rhs = rhs_element list name
@@ -61,7 +62,6 @@ module O = struct
     | `Lower
   ]
 
-
   type operator = element list
   type n_operator = operator name
 
@@ -166,6 +166,7 @@ module Print_AST = struct
           match e with
           | `Named s -> Some (s ^ " Location.wrap")
           | `List ( _, s) -> Some ("(" ^ s ^ " Location.wrap list)")
+          | `Option s -> Some ("(" ^ s ^ " Location.wrap option)")
           | `Token _ -> None
         in
         List.filter_map aux rhs.content in
@@ -246,6 +247,7 @@ module Print_Grammar = struct
       let aux : _ -> O.rhs_element -> _ = fun ppf e ->
           (match e with
           | `Named s -> fprintf ppf "%s = wrap(%s)" letters.(!i) s
+          | `Option s -> fprintf ppf "%s = option(wrap(%s))" letters.(!i) s
           | `List (mode, s) ->
               fprintf ppf "%s = %swrap(%s))"
                 letters.(!i)
@@ -271,7 +273,7 @@ module Print_Grammar = struct
       let i = ref 0 in
       let aux : O.rhs_element -> _ = fun e ->
           let s = (match e with
-          | `Named _ | `List _ -> Some (letters.(!i))
+          | `Named _ | `List _ | `Option _ -> Some (letters.(!i))
           | `Token _ -> i := !i - 1 ; None) in
           i := !i + 1 ; s
       in
@@ -626,13 +628,9 @@ module Type_expression = struct
 
   let application = empty_infix "application" `Left
 
-  (* let pair = infix "pair" `Left COMMA *)
   let tuple = make_name "tuple" [
       `List (Separated_nene COMMA, `Lower)
     ]
-  (* let pair = make_name "tuple" [
-   *     `List (Separated COMMA, `Lower)
-   *   ] *)
 
   let type_variable : O.n_operator = make_name "variable" [ `Named variable_name ]
 
@@ -671,14 +669,44 @@ module Program = struct
       make_name "implicit_named_param" [ `Token TILDE ; `Named variable_name ] ;
     ]
 
+  let type_annotation_name = "type_annotation_"
+
+  let type_annotation : O.rule = make_name type_annotation_name [
+      make_name "" [ `Token COLON ; `Named type_expression_name ] ;
+    ]
+
+  let let_content_name = "let_content"
+  let let_content : O.rule = make_name let_content_name [
+      make_name "" [
+        `Named variable_name ;
+        `List (Naked, param_name) ;
+        `Option type_annotation_name ;
+        `Token EQUAL ;
+        `Named expression_name ;
+      ] ;
+    ]
+
+  (* let statement : O.rule = make_name statement_name [
+   *     make_name "variable_declaration" [`Token LET ; `List (Naked_ne, param_name) ; `Token EQUAL ; `Named expression_name] ;
+   *     make_name "init_declaration" [`Token LET_INIT ; `List (Naked_ne, param_name) ; `Token EQUAL ; `Named expression_name] ;
+   *     make_name "entry_declaration" [`Token LET_ENTRY ; `List (Naked_ne, param_name) ; `Token EQUAL ; `Named expression_name] ;
+   *     make_name "type_declaration" [`Token TYPE ; `Named variable_name ; `Token EQUAL ; `Named type_expression_name] ;
+   *   ] *)
+
   let statement : O.rule = make_name statement_name [
-      make_name "variable_declaration" [`Token LET ; `List (Naked_ne, param_name) ; `Token EQUAL ; `Named expression_name] ;
+      make_name "variable_declaration" [`Token LET ; `Named let_content_name] ;
-      make_name "init_declaration" [`Token LET_INIT ; `List (Naked_ne, param_name) ; `Token EQUAL ; `Named expression_name] ;
+      make_name "init_declaration" [`Token LET_INIT ; `Named let_content_name] ;
-      make_name "entry_declaration" [`Token LET_ENTRY ; `List (Naked_ne, param_name) ; `Token EQUAL ; `Named expression_name] ;
+      make_name "entry_declaration" [`Token LET_ENTRY ; `Named let_content_name] ;
       make_name "type_declaration" [`Token TYPE ; `Named variable_name ; `Token EQUAL ; `Named type_expression_name] ;
     ]
 
-  let singletons = List.map O.rule_singleton [program ; statement ; param]
+  let singletons = List.map O.rule_singleton [
+      let_content ;
+      type_annotation ;
+      program ;
+      statement ;
+      param ;
+    ]
 
 end
 

src/ligo/simplify_multifix.ml

@@ -5,8 +5,23 @@ module O = Ast_simplified
 
 let unwrap : type a . a Location.wrap -> a = Location.unwrap
 
+let type_constants = [
+  ("unit", 0) ;
+  ("string", 0) ;
+  ("nat", 0) ;
+  ("int", 0) ;
+  ("bool", 0) ;
+  ("list", 1) ;
+  ("option", 1) ;
+  ("set", 1) ;
+  ("map", 2) ;
+]
+
 let type_variable : string -> O.type_expression result = fun str ->
-  ok @@ O.T_variable str
+  match List.assoc_opt str type_constants with
+  | Some 0 -> ok @@ O.T_constant (str, [])
+  | Some _ -> simple_fail "non-nullary type constructor"
+  | None -> ok @@ O.T_variable str
 
 let rec type_expression : I.type_expression -> O.type_expression result = fun te ->
   match te with
@@ -60,7 +75,9 @@ let rec expression : I.expression -> O.annotated_expression result = fun e ->
   | E_main m ->
       let%bind m' = bind_map_location expression_main m in
       ok @@ unwrap m'
-  | E_record r ->
+  | E_record r -> expression_record r
+
+and expression_record : _ -> O.annotated_expression result = fun r ->
   let aux : I.e_record_element -> _ = fun re ->
     match re with
     | E_record_element_record_implicit _ -> simple_fail "no implicit record element yet"
@@ -141,42 +158,39 @@ and expression_main : I.expression_main -> O.annotated_expression result = fun e
 
 and expression_no_seq : I.expression_no_seq -> O.annotated_expression result = fun mns ->
   match mns with
-  | _ -> simple_fail "todo"
+  | Es_record r -> expression_record r
+  | Es_let_in _
+  | Es_ifthen _
+  | Es_ifthenelse _
+    -> simple_fail "not block expressions in local expressions yet"
+  | Es_fun _ -> simple_fail "no local functions yet"
+  | Es_match _ -> simple_fail "no match in expressions yet"
+  | Es_main e ->
+      expression_main (unwrap e)
+
+let let_content : I.let_content -> _ result = fun (Let_content (n, args, ty_opt, e)) ->
+  let%bind () =
+    trace_strong (simple_error "no sugar-candy for args yet") @@
+    Assert.assert_list_empty args in
+  let%bind ty =
+    trace_option (simple_error "top-level declarations need a type") @@
+    ty_opt in
+  let%bind e' = bind_map_location expression e in
+  let%bind () =
+    trace_strong (simple_error "no annotation for a top-level expression") @@
+    Assert.assert_none (unwrap e').type_annotation in
+  let e'' = (unwrap e').expression in
+  let%bind ty' =
+    let (I.Type_annotation_ ty') = unwrap ty in
+    bind_map_location type_expression ty' in
+  let ae = O.annotated_expression e'' (Some (unwrap ty')) in
+  ok @@ O.Declaration_constant {name = (unwrap n) ; annotated_expression = ae}
 
 let statement : I.statement -> O.declaration result = fun s ->
   match s with
-  | Statement_variable_declaration ([n], e) ->
+  | Statement_variable_declaration x -> let_content (unwrap x)
-      let%bind (name, ty) =
+  | Statement_init_declaration x -> let_content (unwrap x)
-        let%bind pattern =
+  | Statement_entry_declaration x -> let_content (unwrap x)
-          match unwrap n with
-          | Param_restricted_pattern c -> ok c
-          | Param_implicit_named_param _ -> simple_fail "" in
-        match unwrap pattern with
-        | Pr_restrict c -> (
-            match unwrap c with
-            | P_type_annotation (l, te) -> (
-                let%bind v = match unwrap l with
-                  | P_variable v -> ok v
-                  | _ -> simple_fail "no sugar-candy for regular declarations yet"
-                in
-                ok (v, te)
-              )
-            | _ -> simple_fail "no sugar-candy for regular declarations yet"
-          )
-        | Pr_variable _ -> simple_fail "provide type for top-level declarations!"
-        | Pr_unit _ -> simple_fail "define unit is meaningless"
-      in
-      let name' = unwrap name in
-      let%bind e' = bind_map_location expression e in
-      let%bind ty' = bind_map_location restricted_type_expression ty in
-      let%bind e'' = match (unwrap e').type_annotation with
-        | None -> ok (unwrap e').expression
-        | Some _ -> simple_fail "can't add an annotation at the expression of a declaration" in
-      let ae = O.annotated_expression e'' (Some (unwrap ty')) in
-      ok @@ O.Declaration_constant {name = name' ; annotated_expression = ae}
-  | Statement_variable_declaration _ -> simple_fail "no sugar-candy for fun declarations yet"
-  | Statement_init_declaration _ -> simple_fail "no init declaration yet"
-  | Statement_entry_declaration _ -> simple_fail "no entry declaration yet"
   | Statement_type_declaration (n, te) ->
       let%bind te' = bind_map_location type_expression te in
       ok @@ O.Declaration_type {type_name = unwrap n ; type_expression = unwrap te'}

src/ligo/test/multifix_tests.ml

@@ -7,11 +7,19 @@ let basic () : unit result =
   ok ()
 
 let simplify () : unit result =
-  let%bind raw = User.parse_file "./contracts/new-syntax.mligo" in
+  let%bind raw = User.parse_file "./contracts/basic.mligo" in
   let%bind _simpl = Ligo.Simplify_multifix.main raw in
   ok ()
 
-let main = "Parser Multifix", [
+let integration () : unit result =
+  let%bind raw = User.parse_file "./contracts/basic.mligo" in
+  let%bind simpl = Ligo.Simplify_multifix.main raw in
+  let%bind typed = Ligo.Typer.type_program (Location.unwrap simpl) in
+  let%bind result = Ligo.easy_evaluate_typed "foo" typed in
+  Ligo.AST_Typed.assert_value_eq (Ligo.AST_Typed.Combinators.e_a_int (42 + 127), result)
+
+let main = "Multifix", [
     test "basic" basic ;
-    test "simplify" simplify ;
+    test "simplfiy" simplify ;
+    test "integration" integration ;
 ]