feat(lltz_codegen): smartpy compatible

dune-project

@@ -1,4 +1,4 @@
-(lang dune 3.8)
+(lang dune 3.15)
 
 (name lltz)
 
@@ -19,10 +19,10 @@
   "A common compiler IR for targetting Michelson, the stack-based language of the Tezos blockchain.")
  (depends
   (ocaml
-   (= 4.14.2))
+   (>= 4.14.1))
   dune
   core
   ppx_jane
-  tezos-micheline
+  octez-libs
   ppxlib
   grace))

lib/lltz_codegen/config.ml

@@ -1,4 +1,4 @@
-module I = Michelson.Ast.Instruction
+module I = Lltz_michelson.Ast.Instruction
 
 module ExtStack = struct
   type t =

lib/lltz_codegen/instruction.ml

@@ -5,7 +5,7 @@
    does not match instruction requirements.
 *)
 
-module M = Michelson.Ast
+module M = Lltz_michelson.Ast
 module I = M.Instruction
 module T = M.Type
 
@@ -697,7 +697,7 @@ let next_trace_point = ref (-1)
 
 (* Directly using michelson specified via micheline. Can take arbitrary number of args and return a single value. *)
 let rec micheline_fails
-  (node : (unit, Michelson.Ast.Prim.t) Tezos_micheline.Micheline.node)
+  (node : (unit, Lltz_michelson.Ast.Prim.t) Tezos_micheline.Micheline.node)
   =
   match node with
   | Prim (_, I Failwith, _, _) -> true

lib/lltz_codegen/lltz_codegen.ml

@@ -21,8 +21,8 @@ module LLTZ = struct
 end
 
 module Michelson = struct
-  module Ast = Michelson.Ast
-  module T = Michelson.Ast.Type
+  module Ast = Lltz_michelson.Ast
+  module T = Lltz_michelson.Ast.Type
 end
 
 open Instruction
@@ -359,17 +359,30 @@ and compile_const constant =
 
 (* Compile a primitive by compiling its arguments, then applying the primitive to the arguments. *)
 and compile_prim primitive args =
-  trace ~flag:((Sexp.to_string_hum (LLTZ.P.sexp_of_t primitive))) (
-    let args_instrs = List.map ~f:(compile ) args in
-    match primitive with
-    | LLTZ.P.Failwith -> 
-      seq (List.rev_append args_instrs [ Instruction.failwith ])
-    | LLTZ.P.Never -> seq (List.rev_append args_instrs [ Instruction.never ])
-    | LLTZ.P.Sub ->
-      (seq (List.rev(args_instrs) @ [ prim ~message:(Sexp.to_string_hum (LLTZ.P.sexp_of_t primitive)) (List.length args) 1 (convert_primitive primitive) ]))
-    | _ -> 
-      (seq (List.rev(args_instrs) @ [ prim ~message:(Sexp.to_string_hum (LLTZ.P.sexp_of_t primitive)) (List.length args) 1 (convert_primitive primitive) ]))
-  )
+  trace
+    ~flag:(Sexp.to_string_hum (LLTZ.P.sexp_of_t primitive))
+    (let args_instrs = List.map ~f:compile args in
+     match primitive with
+     | LLTZ.P.Failwith -> seq (List.rev_append args_instrs [ Instruction.failwith ])
+     | LLTZ.P.Never -> seq (List.rev_append args_instrs [ Instruction.never ])
+     | LLTZ.P.Sub ->
+       seq
+         (List.rev args_instrs
+          @ [ prim
+                ~message:(Sexp.to_string_hum (LLTZ.P.sexp_of_t primitive))
+                (List.length args)
+                1
+                (convert_primitive primitive)
+            ])
+     | _ ->
+       seq
+         (List.rev args_instrs
+          @ [ prim
+                ~message:(Sexp.to_string_hum (LLTZ.P.sexp_of_t primitive))
+                (List.length args)
+                1
+                (convert_primitive primitive)
+            ]))
 
 (* Compile a dereference by duplicating the value of the mutable variable on the stack. *)
 and compile_deref name type_ annotations =

lib/lltz_codegen/type.ml

@@ -1,4 +1,4 @@
-module M = Michelson.Ast
+module M = Lltz_michelson.Ast
 module T = M.Type
 
 let tuple ?(annot = None) types =

lib/lltz_ir/ast_builder.ml

@@ -32,15 +32,15 @@ let rec get_proj_type (row : LLTZ.T.t LLTZ.R.t) (path : int list) : LLTZ.T.t =
   match path with
   | i :: path_tail ->
     (match row with
-     | LLTZ.R.Leaf (_, _) -> raise_s [%message "Invalid path" (path : int list)]
+     | LLTZ.R.Leaf (_, _) -> raise_s [%message "Invalid path: unexpected leaf" (path : int list)]
      | LLTZ.R.Node row_list ->
        (match List.nth row_list i with
         | Some expr -> get_proj_type expr path_tail
-        | None -> raise_s [%message "Invalid path" (path : int list)]))
+        | None -> raise_s [%message "Invalid path: out of bounds" (path : int list)]))
   | [] ->
     (match row with
      | LLTZ.R.Leaf (_, ty) -> ty
-     | LLTZ.R.Node _ -> raise_s [%message "Invalid path" (path : int list)])
+     | LLTZ.R.Node _ -> raise_s [%message "Invalid path: unexpected node" (path : int list)])
 ;;
 
 let get_inj_type (context : LLTZ.T.t LLTZ.R.Context.t) : LLTZ.T.desc =
@@ -903,16 +903,17 @@ module Default = struct
   ;;
 
   let concat1 ~range val_list =
-    create ~range (LLTZ.E.Prim (LLTZ.P.Concat1, [val_list]))
-      (
-        match val_list.LLTZ.E.type_.LLTZ.T.desc with
-         | LLTZ.T.List ty -> ty
-         | _ -> raise_s [%message "Expected list or bytes type"]
-      )
+    create
+      ~range
+      (LLTZ.E.Prim (LLTZ.P.Concat1, [ val_list ]))
+      (match val_list.LLTZ.E.type_.LLTZ.T.desc with
+       | LLTZ.T.List ty -> ty
+       | _ -> raise_s [%message "Expected list or bytes type"])
+  ;;
 
   let concat2 ~range val1 val2 =
-    create ~range (LLTZ.E.Prim (LLTZ.P.Concat2, [val1; val2]))
-      val1.LLTZ.E.type_
+    create ~range (LLTZ.E.Prim (LLTZ.P.Concat2, [ val1; val2 ])) val1.LLTZ.E.type_
+  ;;
 
   let get ~range key collection =
     create

lib/michelson/dune → lib/lltz_michelson/dune

@@ -1,10 +1,10 @@
 (library
- (name michelson)
+ (name lltz_michelson)
  (public_name lltz.michelson)
  (inline_tests)
  (libraries
   core
   octez-libs.micheline
  )
  (preprocess
-  (pps ppx_jane)))
+  (pps ppx_jane)))