major refactoring ; now easy to add new operators

src/lib_utils/environment.ml

@@ -1,53 +0,0 @@
-module type PARAMETER = sig
-  type key
-  type value
-  val key_cmp : key -> key -> int
-  val value_cmp : value -> value -> int
-end
-
-let parameter (type key value) ?key_cmp ?value_cmp () : (module PARAMETER with type key = key and type value = value) =
-  (module struct
-    type nonrec key = key
-    type nonrec value = value
-    let key_cmp = Option.unopt ~default:compare key_cmp
-    let value_cmp = Option.unopt ~default:compare value_cmp
-  end)
-
-let int_parameter = (parameter () : (module PARAMETER with type key = int and type value = int))
-module INT_PARAMETER = (val ((parameter () : (module PARAMETER with type key = int and type value = int))))
-
-module type ENVIRONMENT = sig
-  type key
-  type value
-  type t
-
-  val empty : t
-  val get_opt : t -> key -> value option
-  val gets : t -> key -> value list
-  val set : t -> key -> value -> t
-  val del : t -> key -> t
-end
-
-module Make(P:PARAMETER) : ENVIRONMENT with type key = P.key and type value = P.value  = struct
-  type key = P.key
-  type value = P.value
-  type t = (key * value) list
-
-  let empty : t = []
-
-  let gets lst k =
-    let kvs = List.filter (fun (k', _) -> P.key_cmp k k' = 0) lst in
-    List.map snd kvs
-  let get_opt lst k = match gets lst k with
-    | [] -> None
-    | v :: _ -> Some v
-
-  let set lst k v = (k, v) :: lst
-
-  let del lst k =
-    let rec aux acc = function
-      | [] -> List.rev acc
-      | (key, _) :: tl when P.key_cmp key k = 0 -> List.rev acc @ tl
-      | hd :: tl -> aux (hd :: acc) tl in
-    aux [] lst
-end

src/lib_utils/location.ml

@@ -31,3 +31,6 @@ type 'a wrap = {
 let wrap ~loc wrap_content = { wrap_content ; location = loc }
 let unwrap { wrap_content ; _ } = wrap_content
 let map f x = { x with wrap_content = f x.wrap_content }
+
+let lift_region : 'a Region.reg -> 'a wrap = fun x ->
+  wrap ~loc:(File x.region) x.value

src/lib_utils/tezos_utils.ml

@@ -19,7 +19,6 @@ module Cast = Cast
 module Tuple = Tuple
 module Map = X_map
 module Dictionary = Dictionary
-module Environment = Environment
 module Tree = Tree
 module Region = Region
 module Pos = Pos

src/lib_utils/x_memory_proto_alpha.ml

@@ -25,11 +25,13 @@ let ty_eq (type a b)
 let parse_michelson (type aft)
     ?(tezos_context = dummy_environment.tezos_context)
     ?(top_level = Lambda) (michelson:Michelson.t)
+    ?type_logger
     (bef:'a Script_typed_ir.stack_ty) (aft:aft Script_typed_ir.stack_ty)
   =
   let michelson = Michelson.strip_annots michelson in
   let michelson = Michelson.strip_nops michelson in
   parse_instr
+    ?type_logger
     top_level tezos_context
     michelson bef >>=?? fun (j, _) ->
   match j with

src/lib_utils/x_tezos_micheline.ml

@@ -41,6 +41,7 @@ module Michelson = struct
   let i_some = prim I_SOME
   let i_lambda arg ret body = prim ~children:[arg;ret;body] I_LAMBDA
   let i_drop = prim I_DROP
+  let i_exec = prim I_EXEC
 
   let i_if a b = prim ~children:[a;b] I_IF
   let i_if_none a b = prim ~children:[a;b] I_IF_NONE

src/ligo/ast_simplified/dune

@@ -0,0 +1,10 @@
+(library
+  (name ast_simplified)
+  (public_name ligo.ast_simplified)
+  (libraries
+    tezos-utils
+  )
+  (preprocess
+    (pps ppx_let)
+  )
+)

src/ligo/ast_typed/dune

@@ -0,0 +1,11 @@
+(library
+  (name ast_typed)
+  (public_name ligo.ast_typed)
+  (libraries
+    tezos-utils
+    ast_simplified ; Is that a good idea?
+  )
+  (preprocess
+    (pps ppx_let)
+  )
+)

src/ligo/compiler/compiler.ml

@@ -0,0 +1,4 @@
+module Uncompiler = Uncompiler
+module Program = Compiler_program
+module Type = Compiler_type
+module Environment = Compiler_environment

src/ligo/compiler/compiler_environment.ml

@@ -1,5 +1,6 @@
 open Trace
-open Types
+open Mini_c
+open Environment
 open Micheline
 open Memory_proto_alpha.Script_ir_translator
 
@@ -8,61 +9,9 @@ module Stack = Meta_michelson.Stack
 type element = environment_element
 
 module Small = struct
+  open Small
   open Append_tree
 
-  type t' = environment_small'
-  type t = environment_small
-
-  let not_in_env' ?source s t' =
-    let title () = match source with
-      | None -> "Not in environment"
-      | Some source -> Format.asprintf "Not in environment' (%s)" source in
-    let content () =
-      Format.asprintf "Variable : %s, Environment' : %a"
-        s PP.environment_small' t' in
-    error title content
-
-  let not_in_env ?source s t =
-    let title () = match source with
-      | None -> "Not in environment"
-      | Some source -> Format.asprintf "Not in environment (%s)" source in
-    let content () =
-      Format.asprintf "Variable : %s, Environment : %a"
-        s PP.environment_small t in
-    error title content
-
-
-  let has' s = exists' (fun ((x, _):element) -> x = s)
-  let has s = function
-    | Empty -> false
-    | Full x -> has' s x
-
-  let empty : t = empty
-
-  let get_opt = assoc_opt
-
-  let append s (e:t) = if has (fst s) e then e else append s e
-
-  let of_list lst =
-    let rec aux = function
-      | [] -> Empty
-      | hd :: tl -> append hd (aux tl)
-    in
-    aux @@ List.rev lst
-
-
-  let rec to_list' (e:t') =
-    match e with
-    | Leaf x -> [x]
-    | Node {a;b} -> (to_list' a) @ (to_list' b)
-
-  let to_list (e:t) =
-    match e with
-    | Empty -> []
-    | Full x -> to_list' x
-
-  type bound = string list
-
   open Michelson
 
   let rec get_path' = fun s env' ->
@@ -117,17 +66,6 @@ module Small = struct
     | Empty -> ok (dip i_drop)
     | Full x -> to_michelson_append' x
 
-  (* let rec to_mini_c_capture' env : _ -> expression result = function
-   *   | Leaf (n, tv) -> ok (E_variable n, tv, env)
-   *   | Node {a;b} ->
-   *       let%bind ((_, ty_a, _) as a) = to_mini_c_capture' env a in
-   *       let%bind ((_, ty_b, _) as b) = to_mini_c_capture' env b in
-   *       ok (E_constant ("PAIR", [a;b]), (T_pair(ty_a, ty_b) : type_value), env)
-   *
-   * let to_mini_c_capture env = function
-   *   | Empty -> simple_fail "to_mini_c_capture"
-   *   | Full x -> to_mini_c_capture' env x *)
-
   let rec to_mini_c_type' : _ -> type_value = function
     | Leaf (_, t) -> t
     | Node {a;b} -> T_pair(to_mini_c_type' a, to_mini_c_type' b)
@@ -137,44 +75,14 @@ module Small = struct
     | Full x -> to_mini_c_type' x
 end
 
-type t = environment
-
-let empty : t = [Small.empty]
-let extend t : t = Small.empty :: t
-let restrict t : t = List.tl t
-let of_small small : t = [small]
-
-let rec get_opt : t -> string -> type_value option = fun t k ->
-  match t with
-  | [] -> None
-  | hd :: tl -> (
-      match Small.get_opt hd k with
-      | None -> get_opt tl k
-      | Some v -> Some v
-    )
-
-let rec has x : t -> bool = function
-  | [] -> raise (Failure "Schema.Big.has")
-  | [hd] -> Small.has x hd
-  | hd :: tl -> Small.has x hd || has x tl
-let add x : t -> t = function
-  | [] -> raise (Failure "Schema.Big.add")
-  | hd :: tl -> Small.append x hd :: tl
-
-(* let init_function (f:type_value) (binder:string) : t = [Small.init_function binder f] *)
-
 let to_michelson_extend : t -> Michelson.t = fun _e ->
   Michelson.i_comment "empty_extend"
-  (* Michelson.(
-   *   seq [i_push_unit ; i_pair]
-   * ) *)
 
 let to_michelson_restrict : t -> Michelson.t result = fun e ->
   match e with
   | [] -> simple_fail "Restrict empty env"
   | Empty :: _ -> ok @@ Michelson.i_comment "restrict empty"
   | _ -> ok @@ Michelson.(seq [i_comment "restrict" ; i_cdr])
-  (* Michelson.i_cdr *)
 
 let to_ty = Compiler_type.Ty.environment
 let to_michelson_type = Compiler_type.environment
@@ -183,9 +91,6 @@ let rec to_mini_c_type = function
   | [hd] -> Small.to_mini_c_type hd
   | Append_tree.Empty :: tl -> to_mini_c_type tl
   | hd :: tl -> T_pair(Small.to_mini_c_type hd, to_mini_c_type tl)
-(* let to_mini_c_capture = function
- *   | [a] -> Small.to_mini_c_capture a
- *   | _ -> raise (Failure "Schema.Big.to_mini_c_capture") *)
 
 type path = [`Left | `Right] list
 let pp_path : _ -> path -> unit =

src/ligo/compiler/compiler_program.ml

@@ -1,71 +1,32 @@
 open Trace
-open Types
+open Mini_c
 
 module Michelson = Micheline.Michelson
 open Michelson
-module Environment = Compiler_environment
 module Stack = Meta_michelson.Stack
 module Contract_types = Meta_michelson.Types
 
 open Memory_proto_alpha.Script_ir_translator
 
-type predicate =
+open Operators.Compiler
-  | Constant of michelson
-  | Unary of michelson
-  | Binary of michelson
-  | Ternary of michelson
 
-let simple_constant c = Constant ( seq [
+let get_predicate : string -> expression list -> predicate result = fun s lst ->
-    c ; i_pair ;
+  match Map.String.find_opt s Operators.Compiler.predicates with
-  ])
+  | Some x -> ok x
+  | None -> (
+      match s with
+      | "MAP_REMOVE" ->
+          let%bind v = match lst with
+            | [ _ ; expr ] ->
+                let%bind (_, v) = Mini_c.Combinators.(get_t_map (Expression.get_type expr)) in
+                ok v
+            | _ -> simple_fail "mini_c . MAP_REMOVE" in
+          let%bind v_ty = Compiler_type.type_ v in
+          ok @@ simple_binary @@ seq [dip (i_none v_ty) ; prim I_UPDATE ]
+      | x -> simple_fail ("predicate \"" ^ x ^ "\" doesn't exist")
+    )
 
-let simple_unary c = Unary ( seq [
+let rec translate_value (v:value) : michelson result = match v with
-    i_unpair ; c ; i_pair ;
-  ])
-
-let simple_binary c = Binary ( seq [
-    i_unpair ; dip i_unpair ; i_swap ; c ; i_pair ;
-  ])
-
-let simple_ternary c = Ternary ( seq [
-    i_unpair ; dip i_unpair ; dip (dip i_unpair) ; i_swap ; dip i_swap ; i_swap ; c ; i_pair ;
-  ])
-
-let rec get_predicate : string -> expression list -> predicate result = fun s lst ->
-  match s with
-  | "ADD_INT" -> ok @@ simple_binary @@ prim I_ADD
-  | "ADD_NAT" -> ok @@ simple_binary @@ prim I_ADD
-  | "TIMES_INT" -> ok @@ simple_binary @@ prim I_MUL
-  | "TIMES_NAT" -> ok @@ simple_binary @@ prim I_MUL
-  | "NEG" -> ok @@ simple_unary @@ prim I_NEG
-  | "OR" -> ok @@ simple_binary @@ prim I_OR
-  | "AND" -> ok @@ simple_binary @@ prim I_AND
-  | "PAIR" -> ok @@ simple_binary @@ prim I_PAIR
-  | "CAR" -> ok @@ simple_unary @@ prim I_CAR
-  | "CDR" -> ok @@ simple_unary @@ prim I_CDR
-  | "EQ" -> ok @@ simple_binary @@ seq [prim I_COMPARE ; prim I_EQ]
-  | "LT" -> ok @@ simple_binary @@ seq [prim I_COMPARE ; prim I_LT]
-  | "UPDATE" -> ok @@ simple_ternary @@ prim I_UPDATE
-  | "SOME" -> ok @@ simple_unary @@ prim I_SOME
-  | "GET_FORCE" -> ok @@ simple_binary @@ seq [prim I_GET ; i_assert_some]
-  | "GET" -> ok @@ simple_binary @@ prim I_GET
-  | "SIZE" -> ok @@ simple_unary @@ prim I_SIZE
-  | "INT" -> ok @@ simple_unary @@ prim I_INT
-  | "CONS" -> ok @@ simple_binary @@ prim I_CONS
-  (* | "CONS" -> ok @@ simple_binary @@ seq [prim I_SWAP ; prim I_CONS] *)
-  | "MAP_REMOVE" ->
-      let%bind v = match lst with
-        | [ _ ; expr ] ->
-            let%bind (_, v) = Combinators.(get_t_map (Expression.get_type expr)) in
-            ok v
-        | _ -> simple_fail "mini_c . MAP_REMOVE" in
-      let%bind v_ty = Compiler_type.type_ v in
-      ok @@ simple_binary @@ seq [dip (i_none v_ty) ; prim I_UPDATE ]
-  | "MAP_UPDATE" ->
-      ok @@ simple_ternary @@ seq [dip (i_some) ; prim I_UPDATE ]
-  | x -> simple_fail ("predicate \"" ^ x ^ "\" doesn't exist")
-
-and translate_value (v:value) : michelson result = match v with
   | D_bool b -> ok @@ prim (if b then D_True else D_False)
   | D_int n -> ok @@ int (Z.of_int n)
   | D_nat n -> ok @@ int (Z.of_int n)
@@ -118,7 +79,7 @@ and translate_expression (expr:expression) : michelson result =
   let error_message () = Format.asprintf  "%a" PP.expression expr in
 
   let return code =
-    let%bind (Ex_ty schema_ty) = Environment.to_ty env in
+    let%bind (Ex_ty schema_ty) = Compiler_environment.to_ty env in
     let%bind output_type = Compiler_type.type_ ty in
     let%bind (Ex_ty output_ty) =
       let error_message () = Format.asprintf "%a" Michelson.pp output_type in
@@ -127,7 +88,7 @@ and translate_expression (expr:expression) : michelson result =
     let input_stack_ty = Stack.(Contract_types.unit @: schema_ty @: nil) in
     let output_stack_ty = Stack.(Contract_types.(pair output_ty unit) @: schema_ty @: nil) in
     let error_message () =
-      let%bind schema_michelson = Environment.to_michelson_type env in
+      let%bind schema_michelson = Compiler_environment.to_michelson_type env in
       ok @@ Format.asprintf
         "expression : %a\ncode : %a\nschema type : %a\noutput type : %a"
         PP.expression expr
@@ -212,7 +173,7 @@ and translate_expression (expr:expression) : michelson result =
         | _ -> simple_fail "E_applicationing something not appliable"
       )
     | E_variable x ->
-        let%bind (get, _) = Environment.to_michelson_get env x in
+        let%bind (get, _) = Compiler_environment.to_michelson_get env x in
         return @@ seq [
           dip (seq [prim I_DUP ; get]) ;
           i_piar ;
@@ -324,9 +285,9 @@ and translate_statement ((s', w_env) as s:statement) : michelson result =
   let%bind (code : michelson) =
     trace (fun () -> error (thunk "compiling statement") error_message ()) @@ match s' with
     | S_environment_extend ->
-        ok @@ Environment.to_michelson_extend w_env.pre_environment
+        ok @@ Compiler_environment.to_michelson_extend w_env.pre_environment
     | S_environment_restrict ->
-        Environment.to_michelson_restrict w_env.pre_environment
+        Compiler_environment.to_michelson_restrict w_env.pre_environment
     | S_environment_add _ ->
         simple_fail "not ready yet"
     (* | S_environment_add (name, tv) ->
@@ -334,7 +295,7 @@ and translate_statement ((s', w_env) as s:statement) : michelson result =
     | S_declaration (s, expr) ->
         let tv = Combinators.Expression.get_type expr in
         let%bind expr = translate_expression expr in
-        let%bind add = Environment.to_michelson_add (s, tv) w_env.pre_environment in
+        let%bind add = Compiler_environment.to_michelson_add (s, tv) w_env.pre_environment in
         ok (seq [
             i_comment "declaration" ;
             seq [
@@ -348,7 +309,7 @@ and translate_statement ((s', w_env) as s:statement) : michelson result =
           ])
     | S_assignment (s, expr) ->
         let%bind expr = translate_expression expr in
-        let%bind set = Environment.to_michelson_set s w_env.pre_environment in
+        let%bind set = Compiler_environment.to_michelson_set s w_env.pre_environment in
         ok (seq [
             i_comment "assignment" ;
             seq [
@@ -376,7 +337,7 @@ and translate_statement ((s', w_env) as s:statement) : michelson result =
         let%bind some' = translate_regular_block some in
         let%bind add =
           let env' = Environment.extend w_env.pre_environment in
-          Environment.to_michelson_add (name, tv) env' in
+          Compiler_environment.to_michelson_add (name, tv) env' in
         ok @@ (seq [
             i_push_unit ; expr ; i_car ;
             prim ~children:[
@@ -389,11 +350,11 @@ and translate_statement ((s', w_env) as s:statement) : michelson result =
         let%bind block' = translate_regular_block block in
         let%bind restrict_block =
           let env_while = (snd block).pre_environment in
-          Environment.to_michelson_restrict env_while in
+          Compiler_environment.to_michelson_restrict env_while in
         ok @@ (seq [
             i_push_unit ; expr ; i_car ;
             prim ~children:[seq [
-                Environment.to_michelson_extend w_env.pre_environment;
+                Compiler_environment.to_michelson_extend w_env.pre_environment;
                 block' ;
                 restrict_block ;
                 i_push_unit ; expr ; i_car]] I_LOOP ;
@@ -402,7 +363,7 @@ and translate_statement ((s', w_env) as s:statement) : michelson result =
         let%bind expr' = translate_expression expr in
         let%bind (name_path, _) = Environment.get_path name w_env.pre_environment in
         let path = name_path @ lrs in
-        let set_code = Environment.path_to_michelson_set path in
+        let set_code = Compiler_environment.path_to_michelson_set path in
         ok @@ seq [
           i_push_unit ; expr' ; i_car ;
           set_code ;
@@ -410,13 +371,13 @@ and translate_statement ((s', w_env) as s:statement) : michelson result =
   in
 
   let%bind () =
-    let%bind (Ex_ty pre_ty) = Environment.to_ty w_env.pre_environment in
+    let%bind (Ex_ty pre_ty) = Compiler_environment.to_ty w_env.pre_environment in
     let input_stack_ty = Stack.(pre_ty @: nil) in
-    let%bind (Ex_ty post_ty) = Environment.to_ty w_env.post_environment in
+    let%bind (Ex_ty post_ty) = Compiler_environment.to_ty w_env.post_environment in
     let output_stack_ty = Stack.(post_ty @: nil) in
     let error_message () =
-      let%bind pre_env_michelson = Environment.to_michelson_type w_env.pre_environment in
+      let%bind pre_env_michelson = Compiler_environment.to_michelson_type w_env.pre_environment in
-      let%bind post_env_michelson = Environment.to_michelson_type w_env.post_environment in
+      let%bind post_env_michelson = Compiler_environment.to_michelson_type w_env.post_environment in
       ok @@ Format.asprintf
         "statement : %a\ncode : %a\npre type : %a\npost type : %a\n"
         PP.statement s
@@ -446,7 +407,7 @@ and translate_regular_block ((b, env):block) : michelson result =
   in
   let%bind codes =
     let error_message () =
-      let%bind schema_michelson = Environment.to_michelson_type env.pre_environment in
+      let%bind schema_michelson = Compiler_environment.to_michelson_type env.pre_environment in
       ok @@ Format.asprintf "\nblock : %a\nschema : %a\n"
         PP.block (b, env)
         Tezos_utils.Micheline.Michelson.pp schema_michelson

src/ligo/compiler/compiler_type.ml

@@ -1,5 +1,5 @@
 open Trace
-open Types
+open Mini_c.Types
 
 open Tezos_utils.Memory_proto_alpha
 open Script_ir_translator

src/ligo/compiler/dune

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

src/ligo/compiler/uncompiler.ml

@@ -1,5 +1,5 @@
 open Trace
-open Types
+open Mini_c.Types
 open Memory_proto_alpha
 open Script_typed_ir
 open Script_ir_translator

src/ligo/contracts/arithmetic.ligo

@@ -1,6 +1,9 @@
 function plus_op (const n : int) : int is
   begin skip end with n + 42
 
+function minus_op (const n : int) : int is
+  begin skip end with n - 42
+
 function times_op (const n : int) : int is
   begin skip end with n * 42
 

src/ligo/dune

@@ -15,8 +15,13 @@
     tezos-micheline
     meta_michelson
     ligo_parser
-    mini_c
     multifix
+    ast_typed
+    ast_simplified
+    mini_c
+    operators
+    compiler
+    run
   )
   (preprocess
     (pps ppx_let)

src/ligo/ligo.ml

@@ -122,13 +122,13 @@ let transpile_value
   in
 
   let input = Mini_c.Combinators.d_unit in
-  let%bind r = Mini_c.Run.run_entry f input 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 -> Mini_c.Compiler.compiled_program result = Mini_c.Compiler.translate_program
+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 =
@@ -152,7 +152,7 @@ let easy_evaluate_typed (entry:string) (program:AST_Typed.program) : AST_Typed.a
   let%bind result =
     let%bind mini_c_main =
       transpile_entry program entry in
-    Mini_c.Run.run_entry mini_c_main (Mini_c.Combinators.d_unit) 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
@@ -180,7 +180,7 @@ let easy_run_typed
       in
       error title content in
     trace error @@
-    Mini_c.Run.run_entry mini_c_main mini_c_value in
+    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

src/ligo/mini_c/combinators_smart.ml

@@ -3,20 +3,20 @@ open Types
 open Combinators
 
 let basic_int_quote_env : environment =
-  let e = Compiler_environment.empty in
+  let e = Environment.empty in
-  Compiler_environment.add ("input", t_int) e
+  Environment.add ("input", t_int) e
 
 let statement s' env : statement =
   match s' with
-  | S_environment_extend -> s', environment_wrap env (Compiler_environment.extend env)
+  | S_environment_extend -> s', environment_wrap env (Environment.extend env)
-  | S_environment_restrict -> s', environment_wrap env (Compiler_environment.restrict env)
+  | S_environment_restrict -> s', environment_wrap env (Environment.restrict env)
-  | S_environment_add (name, tv) -> s' , environment_wrap env (Compiler_environment.add (name , tv) env)
+  | S_environment_add (name, tv) -> s' , environment_wrap env (Environment.add (name , tv) env)
   | S_cond _ -> s' , id_environment_wrap env
   | S_if_none _ -> s' , id_environment_wrap env
   | S_while _ -> s' , id_environment_wrap env
   | S_patch _ -> s' , id_environment_wrap env
-  | S_declaration (name , e) -> s', environment_wrap env (Compiler_environment.add (name , (Expression.get_type e)) env)
+  | S_declaration (name , e) -> s', environment_wrap env (Environment.add (name , (Expression.get_type e)) env)
-  | S_assignment (name , e) -> s', environment_wrap env (Compiler_environment.add (name , (Expression.get_type e)) env)
+  | S_assignment (name , e) -> s', environment_wrap env (Environment.add (name , (Expression.get_type e)) env)
 
 let block (statements:statement list) : block result =
   match statements with

src/ligo/mini_c/environment.ml

@@ -0,0 +1,119 @@
+open Trace
+open Types
+
+type element = environment_element
+
+module Small = struct
+  open Append_tree
+
+  type t' = environment_small'
+  type t = environment_small
+
+  let not_in_env' ?source s t' =
+    let title () = match source with
+      | None -> "Not in environment"
+      | Some source -> Format.asprintf "Not in environment' (%s)" source in
+    let content () =
+      Format.asprintf "Variable : %s, Environment' : %a"
+        s PP.environment_small' t' in
+    error title content
+
+  let not_in_env ?source s t =
+    let title () = match source with
+      | None -> "Not in environment"
+      | Some source -> Format.asprintf "Not in environment (%s)" source in
+    let content () =
+      Format.asprintf "Variable : %s, Environment : %a"
+        s PP.environment_small t in
+    error title content
+
+
+  let has' s = exists' (fun ((x, _):element) -> x = s)
+  let has s = function
+    | Empty -> false
+    | Full x -> has' s x
+
+  let empty : t = empty
+
+  let get_opt = assoc_opt
+
+  let append s (e:t) = if has (fst s) e then e else append s e
+
+  let of_list lst =
+    let rec aux = function
+      | [] -> Empty
+      | hd :: tl -> append hd (aux tl)
+    in
+    aux @@ List.rev lst
+
+
+  let rec to_list' (e:t') =
+    match e with
+    | Leaf x -> [x]
+    | Node {a;b} -> (to_list' a) @ (to_list' b)
+
+  let to_list (e:t) =
+    match e with
+    | Empty -> []
+    | Full x -> to_list' x
+
+  type bound = string list
+
+  let rec get_path' = fun s env' ->
+    match env' with
+    | Leaf (n, v) when n = s -> ok ([], v)
+    | Leaf _ -> fail @@ not_in_env' ~source:"get_path'" s env'
+    | Node {a;b} ->
+        match%bind bind_lr @@ Tezos_utils.Tuple.map2 (get_path' s) (a,b) with
+        | `Left (lst, v) -> ok ((`Left :: lst), v)
+        | `Right (lst, v) -> ok ((`Right :: lst), v)
+
+  let get_path = fun s env ->
+    match env with
+    | Empty -> fail @@ not_in_env ~source:"get_path" s env
+    | Full x -> get_path' s x
+end
+
+type t = environment
+
+let empty : t = [Small.empty]
+let extend t : t = Small.empty :: t
+let restrict t : t = List.tl t
+let of_small small : t = [small]
+
+let rec get_opt : t -> string -> type_value option = fun t k ->
+  match t with
+  | [] -> None
+  | hd :: tl -> (
+      match Small.get_opt hd k with
+      | None -> get_opt tl k
+      | Some v -> Some v
+    )
+
+let rec has x : t -> bool = function
+  | [] -> raise (Failure "Schema.Big.has")
+  | [hd] -> Small.has x hd
+  | hd :: tl -> Small.has x hd || has x tl
+let add x : t -> t = function
+  | [] -> raise (Failure "Schema.Big.add")
+  | hd :: tl -> Small.append x hd :: tl
+
+type path = [`Left | `Right] list
+let pp_path : _ -> path -> unit =
+  let open Format in
+  let aux ppf lr = match lr with
+    | `Left -> fprintf ppf "L"
+    | `Right -> fprintf ppf "R"
+  in
+  PP_helpers.(list_sep aux (const " "))
+
+let rec get_path : string -> environment -> ([`Left | `Right] list * type_value) result = fun s t ->
+  match t with
+  | [] -> simple_fail "Get path : empty big schema"
+  | [ x ] -> Small.get_path s x
+  | Empty :: tl -> get_path s tl
+  | hd :: tl -> (
+      match%bind bind_lr_lazy (Small.get_path s hd, (fun () -> get_path s tl)) with
+      | `Left (lst, v) -> ok (`Left :: lst, v)
+      | `Right (lst, v) -> ok (`Right :: lst, v)
+    )

src/ligo/mini_c/mini_c.ml

@@ -1,3 +1,4 @@
+module Types = Types
 include Types
 
 module PP = PP
@@ -5,8 +6,4 @@ module Combinators = struct
   include Combinators
   include Combinators_smart
 end
-module Environment = Compiler_environment
+module Environment = Environment
-module Compiler_type = Compiler_type
-module Compiler = Compiler
-module Uncompiler = Uncompiler
-module Run = Run

src/ligo/operators/dune

@@ -1,4 +1,12 @@
 (library
   (name operators)
   (public_name ligo.operators)
+  (libraries
+    tezos-utils
+    ast_typed
+    mini_c
+  )
+  (preprocess
+    (pps ppx_let)
+  )
 )

src/ligo/operators/operators.ml

@@ -114,6 +114,11 @@ module Typer = struct
           | Some t -> ok ("NONE", t))
     ]
 
+  let sub = "SUB" , 2 , [
+      eq_2 (t_int ()) , constant_2 "SUB_INT" (t_int ()) ;
+      eq_2 (t_nat ()) , constant_2 "SUB_NAT" (t_int ()) ;
+    ]
+
   let some = "SOME" , 1 , [
       true_1 , typer'_1 (fun s -> ok ("SOME", t_option s ())) ;
     ]
@@ -166,6 +171,7 @@ module Typer = struct
       ("TIMES_INT" , t_int ()) ;
       ("TIMES_NAT" , t_nat ()) ;
     ] ;
+    sub ;
     none ;
     some ;
     comparator "EQ" ;
@@ -184,3 +190,56 @@ module Typer = struct
 
 end
 
+module Compiler = struct
+
+  module Michelson = Micheline.Michelson
+  open Michelson
+
+  type predicate =
+    | Constant of michelson
+    | Unary of michelson
+    | Binary of michelson
+    | Ternary of michelson
+
+  let simple_constant c = Constant ( seq [
+      c ; i_pair ;
+    ])
+
+  let simple_unary c = Unary ( seq [
+      i_unpair ; c ; i_pair ;
+    ])
+
+  let simple_binary c = Binary ( seq [
+      i_unpair ; dip i_unpair ; i_swap ; c ; i_pair ;
+    ])
+
+  let simple_ternary c = Ternary ( seq [
+      i_unpair ; dip i_unpair ; dip (dip i_unpair) ; i_swap ; dip i_swap ; i_swap ; c ; i_pair ;
+    ])
+
+  let predicates = Map.String.of_list [
+    ("ADD_INT" , simple_binary @@ prim I_ADD) ;
+    ("ADD_NAT" , simple_binary @@ prim I_ADD) ;
+    ("SUB_INT" , simple_binary @@ prim I_SUB) ;
+    ("SUB_NAT" , simple_binary @@ prim I_SUB) ;
+    ("TIMES_INT" , simple_binary @@ prim I_MUL) ;
+    ("TIMES_NAT" , simple_binary @@ prim I_MUL) ;
+    ("NEG" , simple_unary @@ prim I_NEG) ;
+    ("OR" , simple_binary @@ prim I_OR) ;
+    ("AND" , simple_binary @@ prim I_AND) ;
+    ("PAIR" , simple_binary @@ prim I_PAIR) ;
+    ("CAR" , simple_unary @@ prim I_CAR) ;
+    ("CDR" , simple_unary @@ prim I_CDR) ;
+    ("EQ" , simple_binary @@ seq [prim I_COMPARE ; prim I_EQ]) ;
+    ("LT" , simple_binary @@ seq [prim I_COMPARE ; prim I_LT]) ;
+    ("UPDATE" , simple_ternary @@ prim I_UPDATE) ;
+    ("SOME" , simple_unary @@ prim I_SOME) ;
+    ("GET_FORCE" , simple_binary @@ seq [prim I_GET ; i_assert_some]) ;
+    ("GET" , simple_binary @@ prim I_GET) ;
+    ("SIZE" , simple_unary @@ prim I_SIZE) ;
+    ("INT" , simple_unary @@ prim I_INT) ;
+    ("CONS" , simple_binary @@ prim I_CONS) ;
+    ( "MAP_UPDATE" , simple_ternary @@ seq [dip (i_some) ; prim I_UPDATE ]) ;
+  ]
+
+end

src/ligo/run/dune

@@ -0,0 +1,14 @@
+(library
+  (name run)
+  (public_name ligo.run)
+  (libraries
+    tezos-utils
+    meta_michelson
+    mini_c
+    compiler
+  )
+  (preprocess
+    (pps ppx_let)
+  )
+  (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Tezos_utils ))
+)

src/ligo/run/from_mini_c.ml

@@ -1,10 +1,10 @@
 open Trace
-open Types
+open Mini_c
-open Compiler
+open Compiler.Program
 open Memory_proto_alpha.Script_ir_translator
 
 let run_aux (program:compiled_program) (input_michelson:Michelson.t) : ex_typed_value result =
-  let Compiler.{input;output;body} : compiled_program = program in
+  let Compiler.Program.{input;output;body} : compiled_program = program in
   let (Ex_ty input_ty) = input in
   let (Ex_ty output_ty) = output in
   let%bind input =
@@ -41,14 +41,14 @@ let run_entry (entry:anon_function) (input:value) : value result =
     translate_entry entry in
   let%bind input_michelson = translate_value input in
   let%bind ex_ty_value = run_aux compiled input_michelson in
-  let%bind (result : value) = Uncompiler.translate_value ex_ty_value in
+  let%bind (result : value) = Compiler.Uncompiler.translate_value ex_ty_value in
   ok result
 
 let run (program:program) (input:value) : value result =
   let%bind input_michelson = translate_value input in
   let%bind compiled = translate_program program "main" in
   let%bind ex_ty_value = run_aux compiled input_michelson in
-  let%bind (result : value) = Uncompiler.translate_value ex_ty_value in
+  let%bind (result : value) = Compiler.Uncompiler.translate_value ex_ty_value in
   ok result
 
 let expression_to_value (e:expression) : value result =

src/ligo/run/run.ml

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

src/ligo/simplify.ml

@@ -144,6 +144,8 @@ let rec simpl_expression (t:Raw.expr) : ae result =
       ok @@ annotated_expression (E_constant ("NONE", [])) (Some (Combinators.t_option type_expr'))
   | EArith (Add c) ->
       simpl_binop "ADD" c.value
+  | EArith (Sub c) ->
+      simpl_binop "SUB" c.value
   | EArith (Mult c) ->
       simpl_binop "TIMES" c.value
   | EArith (Int n) ->

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.run_entry e param in
+  let%bind result = 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

@@ -164,8 +164,9 @@ let arithmetic () : unit result =
     @@ List.map aux
     @@ [
       ("plus_op", fun n -> e_a_int (n + 42)) ;
+      ("minus_op", fun n -> e_a_int (n - 42)) ;
       ("times_op", fun n -> e_a_int (n * 42)) ;
-      (* ("int_op", fun n -> e_a_int n) ; *)
+      ("int_op", fun n -> e_a_int n) ;
     ] in
   ok ()