dune-capsulate

src/ligo/ast_simplified/combinators.ml

@@ -2,12 +2,15 @@ open Types
 
 module SMap = Map.String
 
+let get_name : named_expression -> string = fun x -> x.name
+let get_type_name : named_type_expression -> string = fun x -> x.type_name
 let get_type_annotation (x:annotated_expression) = x.type_annotation
 
 let t_bool      : type_expression = T_constant ("bool", [])
 let t_string    : type_expression = T_constant ("string", [])
 let t_bytes     : type_expression = T_constant ("bytes", [])
 let t_int       : type_expression = T_constant ("int", [])
+let t_operation : type_expression = T_constant ("operation", [])
 let t_nat       : type_expression = T_constant ("nat", [])
 let t_unit      : type_expression = T_constant ("unit", [])
 let t_option  o : type_expression = T_constant ("option", [o])

src/ligo/dune

@@ -14,14 +14,7 @@
     tezos-utils
     tezos-micheline
     meta_michelson
-    ligo_parser
+    main
-    multifix
-    ast_typed
-    ast_simplified
-    mini_c
-    operators
-    compiler
-    run
   )
   (preprocess
     (pps tezos-utils.ppx_let_generalized)

src/ligo/ligo.ml

@@ -1,178 +1 @@
-open Trace
+include Main
-module Parser = Parser
-module AST_Raw = Ligo_parser.AST
-module AST_Simplified = Ast_simplified
-module AST_Typed = Ast_typed
-module Mini_c = Mini_c
-module Typer = Typer
-module Transpiler = Transpiler
-module Parser_multifix = Multifix
-module Simplify_multifix = Simplify_multifix
-
-
-let simplify (p:AST_Raw.t) : Ast_simplified.program result = Simplify.simpl_program p
-let simplify_expr (e:AST_Raw.expr) : Ast_simplified.annotated_expression result = Simplify.simpl_expression e
-let unparse_simplified_expr (e:AST_Simplified.annotated_expression) : string result =
-  ok @@ Format.asprintf "%a" AST_Simplified.PP.annotated_expression e
-
-let type_ (p:AST_Simplified.program) : AST_Typed.program result = Typer.type_program p
-let type_expression ?(env:Typer.Environment.t = Typer.Environment.full_empty)
-    (e:AST_Simplified.annotated_expression) : AST_Typed.annotated_expression result =
-  Typer.type_annotated_expression env e
-let untype_expression (e:AST_Typed.annotated_expression) : AST_Simplified.annotated_expression result = Typer.untype_annotated_expression e
-
-let transpile (p:AST_Typed.program) : Mini_c.program result = Transpiler.translate_program p
-let transpile_entry (p:AST_Typed.program) (name:string) : Mini_c.anon_function result = Transpiler.translate_entry p name
-let transpile_expression ?(env:Mini_c.Environment.t = Mini_c.Environment.empty)
-    (e:AST_Typed.annotated_expression) : Mini_c.expression result = Transpiler.translate_annotated_expression env e
-let transpile_value
-    (e:AST_Typed.annotated_expression) : Mini_c.value result =
-  let%bind f =
-    let open Transpiler in
-    let (f, t) = functionalize e in
-    let%bind main = translate_main f t in
-    ok main
-  in
-
-  let input = Mini_c.Combinators.d_unit in
-  let%bind r = Run.Mini_c.run_entry f input in
-  ok r
-
-let untranspile_value (v : Mini_c.value) (e:AST_Typed.type_value) : AST_Typed.annotated_expression result =
-  Transpiler.untranspile v e
-
-let compile : Mini_c.program -> string -> Compiler.Program.compiled_program result = Compiler.Program.translate_program
-
-let type_file ?(debug_simplify = false) ?(debug_typed = false)
-    (path:string) : AST_Typed.program result =
-  let%bind raw = Parser.parse_file path in
-  let%bind simpl =
-    trace (simple_error "simplifying") @@
-    simplify raw in
-  (if debug_simplify then
-     Format.(printf "Simplified : %a\n%!" AST_Simplified.PP.program simpl)
-  ) ;
-  let%bind typed =
-    trace (simple_error "typing") @@
-    type_ simpl in
-  (if debug_typed then (
-      Format.(printf "Typed : %a\n%!" AST_Typed.PP.program typed)
-    )) ;
-  ok typed
-
-
-let easy_evaluate_typed (entry:string) (program:AST_Typed.program) : AST_Typed.annotated_expression result =
-  let%bind result =
-    let%bind mini_c_main =
-      transpile_entry program entry in
-    Run.Mini_c.run_entry mini_c_main (Mini_c.Combinators.d_unit) in
-  let%bind typed_result =
-    let%bind typed_main = Ast_typed.get_entry program entry in
-    untranspile_value result typed_main.type_annotation in
-  ok typed_result
-
-let easy_evaluate_typed_simplified (entry:string) (program:AST_Typed.program) : Ast_simplified.annotated_expression result =
-  let%bind result =
-    let%bind mini_c_main =
-      transpile_entry program entry in
-    Run.Mini_c.run_entry mini_c_main (Mini_c.Combinators.d_unit) in
-  let%bind typed_result =
-    let%bind typed_main = Ast_typed.get_entry program entry in
-    untranspile_value result typed_main.type_annotation in
-  let%bind annotated_result = untype_expression typed_result in
-  ok annotated_result
-
-let easy_evaluate_typed = trace_f_2_ez easy_evaluate_typed (thunk "easy evaluate typed")
-
-let easy_run_typed
-    ?(debug_mini_c = false) (entry:string)
-    (program:AST_Typed.program) (input:AST_Typed.annotated_expression) : AST_Typed.annotated_expression result =
-  let%bind mini_c_main =
-    trace (simple_error "transpile mini_c entry") @@
-    transpile_entry program entry in
-  (if debug_mini_c then
-     Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main.content)
-  ) ;
-
-  let%bind mini_c_value = transpile_value input in
-
-  let%bind mini_c_result =
-    let error =
-      let title () = "run Mini_c" in
-      let content () =
-        Format.asprintf "\n%a" Mini_c.PP.function_ mini_c_main.content
-      in
-      error title content in
-    trace error @@
-    Run.Mini_c.run_entry mini_c_main mini_c_value in
-  let%bind typed_result =
-    let%bind main_result_type =
-      let%bind typed_main = Ast_typed.get_functional_entry program entry in
-      match (snd typed_main).type_value' with
-      | T_function (_, result) -> ok result
-      | _ -> simple_fail "main doesn't have fun type" in
-    untranspile_value mini_c_result main_result_type in
-  ok typed_result
-
-let easy_run_typed_simplified
-    ?(debug_mini_c = false) (entry:string)
-    (program:AST_Typed.program) (input:Ast_simplified.annotated_expression) : Ast_simplified.annotated_expression result =
-  let%bind mini_c_main =
-    trace (simple_error "transpile mini_c entry") @@
-    transpile_entry program entry in
-  (if debug_mini_c then
-     Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main.content)
-  ) ;
-
-  let%bind typed_value = type_expression input in
-  let%bind mini_c_value = transpile_value typed_value in
-
-  let%bind mini_c_result =
-    let error =
-      let title () = "run Mini_c" in
-      let content () =
-        Format.asprintf "\n%a" Mini_c.PP.function_ mini_c_main.content
-      in
-      error title content in
-    trace error @@
-    Run.Mini_c.run_entry mini_c_main mini_c_value in
-  let%bind typed_result =
-    let%bind main_result_type =
-      let%bind typed_main = Ast_typed.get_functional_entry program entry in
-      match (snd typed_main).type_value' with
-      | T_function (_, result) -> ok result
-      | _ -> simple_fail "main doesn't have fun type" in
-    untranspile_value mini_c_result main_result_type in
-  let%bind annotated_result = untype_expression typed_result in
-  ok annotated_result
-
-let easy_run_main_typed
-    ?(debug_mini_c = false)
-    (program:AST_Typed.program) (input:AST_Typed.annotated_expression) : AST_Typed.annotated_expression result =
-  easy_run_typed ~debug_mini_c "main" program input
-
-let easy_run_main (path:string) (input:string) : AST_Typed.annotated_expression result =
-  let%bind typed = type_file path in
-
-  let%bind raw_expr = Parser.parse_expression input in
-  let%bind simpl_expr = simplify_expr raw_expr in
-  let%bind typed_expr = type_expression simpl_expr in
-  easy_run_main_typed typed typed_expr
-
-let compile_file (source: string) (entry_point:string) : Micheline.Michelson.t result =
-  let%bind raw =
-    trace (simple_error "parsing") @@
-    Parser.parse_file source in
-  let%bind simplified =
-    trace (simple_error "simplifying") @@
-    simplify raw in
-  let%bind typed =
-    trace (simple_error "typing") @@
-    type_ simplified in
-  let%bind mini_c =
-    trace (simple_error "transpiling") @@
-    transpile typed in
-  let%bind {body = michelson} =
-    trace (simple_error "compiling") @@
-    compile mini_c entry_point in
-  ok michelson

src/ligo/main/contract.ml

@@ -0,0 +1,16 @@
+open Trace
+
+include struct
+  open Ast_simplified
+  open Combinators
+
+  let assert_entry_point_defined : program -> string -> unit result =
+    fun program entry_point ->
+      let aux : declaration -> bool = fun declaration ->
+        match declaration with
+        | Declaration_type _ -> false
+        | Declaration_constant ne -> get_name ne = entry_point
+      in
+      trace_strong (simple_error "no entry-point with given name") @@
+      Assert.assert_true @@ List.exists aux @@ List.map Location.unwrap program
+end

src/ligo/main/dune

@@ -0,0 +1,20 @@
+(library
+  (name main)
+  (public_name ligo.main)
+  (libraries
+    tezos-utils
+    parser
+    simplify
+    ast_simplified
+    typer
+    ast_typed
+    transpiler
+    mini_c
+    operators
+    compiler
+  )
+  (preprocess
+    (pps tezos-utils.ppx_let_generalized)
+  )
+  (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Tezos_utils ))
+)

src/ligo/main/main.ml

@@ -0,0 +1,180 @@
+module Run_mini_c = Run_mini_c
+
+open Trace
+module Parser = Parser
+module AST_Raw = Parser.Pascaligo.AST
+module AST_Simplified = Ast_simplified
+module AST_Typed = Ast_typed
+module Mini_c = Mini_c
+module Typer = Typer
+module Transpiler = Transpiler
+(* module Parser_multifix = Multifix
+ * module Simplify_multifix = Simplify_multifix *)
+
+
+let simplify (p:AST_Raw.t) : Ast_simplified.program result = Simplify.Pascaligo.simpl_program p
+let simplify_expr (e:AST_Raw.expr) : Ast_simplified.annotated_expression result = Simplify.Pascaligo.simpl_expression e
+let unparse_simplified_expr (e:AST_Simplified.annotated_expression) : string result =
+  ok @@ Format.asprintf "%a" AST_Simplified.PP.annotated_expression e
+
+let type_ (p:AST_Simplified.program) : AST_Typed.program result = Typer.type_program p
+let type_expression ?(env:Typer.Environment.t = Typer.Environment.full_empty)
+    (e:AST_Simplified.annotated_expression) : AST_Typed.annotated_expression result =
+  Typer.type_annotated_expression env e
+let untype_expression (e:AST_Typed.annotated_expression) : AST_Simplified.annotated_expression result = Typer.untype_annotated_expression e
+
+let transpile (p:AST_Typed.program) : Mini_c.program result = Transpiler.translate_program p
+let transpile_entry (p:AST_Typed.program) (name:string) : Mini_c.anon_function result = Transpiler.translate_entry p name
+let transpile_expression ?(env:Mini_c.Environment.t = Mini_c.Environment.empty)
+    (e:AST_Typed.annotated_expression) : Mini_c.expression result = Transpiler.translate_annotated_expression env e
+let transpile_value
+    (e:AST_Typed.annotated_expression) : Mini_c.value result =
+  let%bind f =
+    let open Transpiler in
+    let (f, t) = functionalize e in
+    let%bind main = translate_main f t in
+    ok main
+  in
+
+  let input = Mini_c.Combinators.d_unit in
+  let%bind r = Run_mini_c.run_entry f input in
+  ok r
+
+let untranspile_value (v : Mini_c.value) (e:AST_Typed.type_value) : AST_Typed.annotated_expression result =
+  Transpiler.untranspile v e
+
+let compile : Mini_c.program -> string -> Compiler.Program.compiled_program result = Compiler.Program.translate_program
+
+let type_file ?(debug_simplify = false) ?(debug_typed = false)
+    (path:string) : AST_Typed.program result =
+  let%bind raw = Parser.parse_file path in
+  let%bind simpl =
+    trace (simple_error "simplifying") @@
+    simplify raw in
+  (if debug_simplify then
+     Format.(printf "Simplified : %a\n%!" AST_Simplified.PP.program simpl)
+  ) ;
+  let%bind typed =
+    trace (simple_error "typing") @@
+    type_ simpl in
+  (if debug_typed then (
+      Format.(printf "Typed : %a\n%!" AST_Typed.PP.program typed)
+    )) ;
+  ok typed
+
+
+let easy_evaluate_typed (entry:string) (program:AST_Typed.program) : AST_Typed.annotated_expression result =
+  let%bind result =
+    let%bind mini_c_main =
+      transpile_entry program entry in
+    Run_mini_c.run_entry mini_c_main (Mini_c.Combinators.d_unit) in
+  let%bind typed_result =
+    let%bind typed_main = Ast_typed.get_entry program entry in
+    untranspile_value result typed_main.type_annotation in
+  ok typed_result
+
+let easy_evaluate_typed_simplified (entry:string) (program:AST_Typed.program) : Ast_simplified.annotated_expression result =
+  let%bind result =
+    let%bind mini_c_main =
+      transpile_entry program entry in
+    Run_mini_c.run_entry mini_c_main (Mini_c.Combinators.d_unit) in
+  let%bind typed_result =
+    let%bind typed_main = Ast_typed.get_entry program entry in
+    untranspile_value result typed_main.type_annotation in
+  let%bind annotated_result = untype_expression typed_result in
+  ok annotated_result
+
+let easy_evaluate_typed = trace_f_2_ez easy_evaluate_typed (thunk "easy evaluate typed")
+
+let easy_run_typed
+    ?(debug_mini_c = false) (entry:string)
+    (program:AST_Typed.program) (input:AST_Typed.annotated_expression) : AST_Typed.annotated_expression result =
+  let%bind mini_c_main =
+    trace (simple_error "transpile mini_c entry") @@
+    transpile_entry program entry in
+  (if debug_mini_c then
+     Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main.content)
+  ) ;
+
+  let%bind mini_c_value = transpile_value input in
+
+  let%bind mini_c_result =
+    let error =
+      let title () = "run Mini_c" in
+      let content () =
+        Format.asprintf "\n%a" Mini_c.PP.function_ mini_c_main.content
+      in
+      error title content in
+    trace error @@
+    Run_mini_c.run_entry mini_c_main mini_c_value in
+  let%bind typed_result =
+    let%bind main_result_type =
+      let%bind typed_main = Ast_typed.get_functional_entry program entry in
+      match (snd typed_main).type_value' with
+      | T_function (_, result) -> ok result
+      | _ -> simple_fail "main doesn't have fun type" in
+    untranspile_value mini_c_result main_result_type in
+  ok typed_result
+
+let easy_run_typed_simplified
+    ?(debug_mini_c = false) (entry:string)
+    (program:AST_Typed.program) (input:Ast_simplified.annotated_expression) : Ast_simplified.annotated_expression result =
+  let%bind mini_c_main =
+    trace (simple_error "transpile mini_c entry") @@
+    transpile_entry program entry in
+  (if debug_mini_c then
+     Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main.content)
+  ) ;
+
+  let%bind typed_value = type_expression input in
+  let%bind mini_c_value = transpile_value typed_value in
+
+  let%bind mini_c_result =
+    let error =
+      let title () = "run Mini_c" in
+      let content () =
+        Format.asprintf "\n%a" Mini_c.PP.function_ mini_c_main.content
+      in
+      error title content in
+    trace error @@
+    Run_mini_c.run_entry mini_c_main mini_c_value in
+  let%bind typed_result =
+    let%bind main_result_type =
+      let%bind typed_main = Ast_typed.get_functional_entry program entry in
+      match (snd typed_main).type_value' with
+      | T_function (_, result) -> ok result
+      | _ -> simple_fail "main doesn't have fun type" in
+    untranspile_value mini_c_result main_result_type in
+  let%bind annotated_result = untype_expression typed_result in
+  ok annotated_result
+
+let easy_run_main_typed
+    ?(debug_mini_c = false)
+    (program:AST_Typed.program) (input:AST_Typed.annotated_expression) : AST_Typed.annotated_expression result =
+  easy_run_typed ~debug_mini_c "main" program input
+
+let easy_run_main (path:string) (input:string) : AST_Typed.annotated_expression result =
+  let%bind typed = type_file path in
+
+  let%bind raw_expr = Parser.parse_expression input in
+  let%bind simpl_expr = simplify_expr raw_expr in
+  let%bind typed_expr = type_expression simpl_expr in
+  easy_run_main_typed typed typed_expr
+
+let compile_file (source: string) (entry_point:string) : Micheline.Michelson.t result =
+  let%bind raw =
+    trace (simple_error "parsing") @@
+    Parser.parse_file source in
+  let%bind simplified =
+    trace (simple_error "simplifying") @@
+    simplify raw in
+  let%bind typed =
+    trace (simple_error "typing") @@
+    type_ simplified in
+  let%bind mini_c =
+    trace (simple_error "transpiling") @@
+    transpile typed in
+  let%bind {body = michelson} =
+    trace (simple_error "compiling") @@
+    compile mini_c entry_point in
+  ok michelson

src/ligo/parser/camligo/dune

@@ -1,6 +1,6 @@
 (library
-  (name multifix)
+  (name parser_camligo)
-  (public_name ligo.multifix)
+  (public_name ligo.parser.camligo)
   (libraries
     tezos-utils
     lex

src/ligo/parser/dune

@@ -0,0 +1,12 @@
+(library
+  (name parser)
+  (public_name ligo.parser)
+  (libraries
+    tezos-utils
+    parser_pascaligo
+    parser_camligo
+  )
+  (preprocess
+    (pps tezos-utils.ppx_let_generalized)
+  )
+)

src/ligo/parser/parser.ml

@@ -1,6 +1,11 @@
 open Trace
-open Ligo_parser
+
-module AST_Raw = Ligo_parser.AST
+module Pascaligo = Parser_pascaligo
+module Camligo = Parser_camligo
+
+open Parser_pascaligo
+module AST_Raw = Parser_pascaligo.AST
+
 
 let parse_file (source: string) : AST_Raw.t result =
   let pp_input =

src/ligo/parser/pascaligo/dune

@@ -7,8 +7,8 @@
  (flags -la 1 --explain --external-tokens LexToken))
 
 (library
- (name ligo_parser)
+ (name parser_pascaligo)
- (public_name ligo.parser)
+ (public_name ligo.parser.pascaligo)
  (modules_without_implementation Error)
  (libraries
    getopt

src/ligo/run/run.ml

@@ -1 +0,0 @@
-module Mini_c = From_mini_c

src/ligo/simplify/camligo.ml

@@ -1,6 +1,6 @@
 open Trace
 open Function
-module I = Multifix.Ast
+module I = Parser.Camligo.Ast
 module O = Ast_simplified
 open O.Combinators
 

src/ligo/simplify/dune

@@ -0,0 +1,14 @@
+(library
+  (name simplify)
+  (public_name ligo.simplify)
+  (libraries
+    tezos-utils
+    parser
+    ast_simplified
+    operators
+  )
+  (preprocess
+    (pps tezos-utils.ppx_let_generalized)
+  )
+  (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Tezos_utils ))
+)

src/ligo/simplify/pascaligo.ml

@@ -1,7 +1,7 @@
 open Trace
 open Ast_simplified
 
-module Raw = Ligo_parser.AST
+module Raw = Parser.Pascaligo.AST
 module SMap = Map.String
 
 open Combinators
@@ -425,7 +425,7 @@ and simpl_single_instruction : Raw.single_instr -> instruction result = fun t ->
             ok @@ I_assignment {name = name.value ; annotated_expression = value_expr}
           )
         | Path path -> (
-            let err_content () = Format.asprintf "%a" (PP_helpers.printer Ligo_parser.ParserLog.print_path) path in
+            let err_content () = Format.asprintf "%a" (PP_helpers.printer Parser.Pascaligo.ParserLog.print_path) path in
             fail @@ (fun () -> error (thunk "no path assignments") err_content ())
           )
         | MapPath v -> (
@@ -456,7 +456,7 @@ and simpl_single_instruction : Raw.single_instr -> instruction result = fun t ->
       let%bind record = match r.path with
         | Name v -> ok v.value
         | path -> (
-            let err_content () = Format.asprintf "%a" (PP_helpers.printer Ligo_parser.ParserLog.print_path) path in
+            let err_content () = Format.asprintf "%a" (PP_helpers.printer Parser.Pascaligo.ParserLog.print_path) path in
             fail @@ (fun () -> error (thunk "no complex record patch yet") err_content ())
           )
       in

src/ligo/simplify/simplify.ml

@@ -0,0 +1,2 @@
+module Pascaligo = Pascaligo
+module Camligo = Camligo

src/ligo/test/compiler_tests.ml

@@ -5,7 +5,7 @@ open Test_helpers
 
 let run_entry_int (e:anon_function) (n:int) : int result =
   let param : value = D_int n in
-  let%bind result = Run.Mini_c.run_entry e param in
+  let%bind result = Main.Run_mini_c.run_entry e param in
   match result with
   | D_int n -> ok n
   | _ -> simple_fail "result is not an int"

src/ligo/test/integration_tests.ml

@@ -286,7 +286,7 @@ let quote_declarations () : unit result =
 let counter_contract () : unit result =
   let%bind program = type_file "./contracts/counter.ligo" in
   let make_input = fun n-> e_a_pair (e_a_int n) (e_a_int 42) in
-  let make_expected = fun n -> e_a_pair (e_a_list [] (t_int)) (e_a_int (42 + n)) in
+  let make_expected = fun n -> e_a_pair (e_a_list [] t_operation) (e_a_int (42 + n)) in
   expect_n program "main" make_input make_expected
 
 let main = "Integration (End to End)", [

src/ligo/test/multifix_tests.ml

@@ -1,6 +1,6 @@
 open Trace
 open Test_helpers
-open Ligo.Parser_multifix
+open Parser.Camligo
 
 let basic () : unit result =
   let%bind _ = User.parse_file "./contracts/new-syntax.mligo" in
@@ -8,12 +8,12 @@ let basic () : unit result =
 
 let simplify () : unit result =
   let%bind raw = User.parse_file "./contracts/basic.mligo" in
-  let%bind _simpl = Ligo.Simplify_multifix.main raw in
+  let%bind _simpl = Simplify.Camligo.main raw in
   ok ()
 
 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 simpl = Simplify.Camligo.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_empty_int (42 + 127), result)

src/ligo/transpiler/dune

@@ -1,11 +1,11 @@
 (library
-  (name run)
+  (name transpiler)
-  (public_name ligo.run)
+  (public_name ligo.transpiler)
   (libraries
     tezos-utils
-    meta_michelson
+    ast_typed
     mini_c
-    compiler
+    operators
   )
   (preprocess
     (pps tezos-utils.ppx_let_generalized)

src/ligo/typer/dune

@@ -0,0 +1,14 @@
+(library
+  (name typer)
+  (public_name ligo.typer)
+  (libraries
+    tezos-utils
+    ast_simplified
+    ast_typed
+    operators
+  )
+  (preprocess
+    (pps tezos-utils.ppx_let_generalized)
+  )
+  (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Tezos_utils ))
+)