moving stuff around

src/lib_utils/PP.ml

@@ -0,0 +1,23 @@
+open Format
+let string : formatter -> string -> unit = fun ppf s -> fprintf ppf "%s" s
+let tag tag : formatter -> unit -> unit = fun ppf () -> fprintf ppf tag
+let new_line : formatter -> unit -> unit = tag "@;"
+let rec new_lines n ppf () =
+  match n with
+  | 0 -> new_line ppf ()
+  | n -> new_line ppf () ; new_lines (n-1) ppf ()
+let const const : formatter -> unit -> unit = fun ppf () -> fprintf ppf "%s" const
+let comment : formatter -> string -> unit = fun ppf s -> fprintf ppf "(* %s *)" s
+let list_sep value separator = pp_print_list ~pp_sep:separator value
+let ne_list_sep value separator ppf (hd, tl) =
+  value ppf hd ;
+  separator ppf () ;
+  pp_print_list ~pp_sep:separator value ppf tl
+
+let pair_sep value sep ppf (a, b) = fprintf ppf "%a %s %a" value a sep value b
+let smap_sep value sep ppf m =
+  let module SMap = X_map.String in
+  let aux k v prev = (k, v) :: prev in
+  let new_pp ppf (k, v) = fprintf ppf "%s -> %a" k value v in
+  let lst = List.rev @@ SMap.fold aux m [] in
+  fprintf ppf "%a" (list_sep new_pp sep) lst

src/lib_utils/dictionary.ml

@@ -0,0 +1,53 @@
+open Trace
+
+module type DICTIONARY = sig
+  type ('a, 'b) t
+
+  val get_exn : ('a, 'b) t -> 'a -> 'b
+  val get : ('a, 'b) t -> 'a -> 'b result
+
+  val set :
+    ?equal:('a -> 'a -> bool) ->
+    ('a, 'b) t -> 'a -> 'b -> ('a, 'b) t
+
+  val del :
+    ?equal:('a -> 'a -> bool) ->
+    ('a, 'b) t -> 'a -> ('a, 'b) t
+
+  val to_list : ('a, 'b) t -> ('a * 'b) list
+end
+
+module Assoc : DICTIONARY = struct
+
+  type ('a, 'b) t = ('a * 'b) list
+
+  let get_exn x y = List.assoc y x
+
+  let get x y = generic_try (simple_error "Dictionry.get") @@ fun () -> get_exn x y
+
+  let set ?equal lst a b =
+    let equal : 'a -> 'a -> bool =
+      Option.unopt
+        ~default:(=) equal
+    in
+    let rec aux acc = function
+      | [] -> List.rev acc
+      | (key, _)::tl when equal key a -> aux ((key, b) :: acc) tl
+      | hd::tl -> aux (hd :: acc) tl
+    in
+    aux [] lst
+
+  let del ?equal lst a =
+    let equal : 'a -> 'a -> bool =
+      Option.unopt
+        ~default:(=) equal
+    in
+    let rec aux acc = function
+      | [] -> List.rev acc
+      | (key, _)::tl when equal key a -> aux acc tl
+      | hd::tl -> aux (hd :: acc) tl
+    in
+    aux [] lst
+
+  let to_list x = x
+end

src/lib_utils/tezos_utils.ml

@@ -1,90 +1,20 @@
 module Stdlib_unix = Tezos_stdlib_unix
-module Crypto = Tezos_crypto
 module Data_encoding = Tezos_data_encoding
-module Error_monad = X_error_monad
+module Crypto = Tezos_crypto
 module Signature = Tezos_base.TzPervasives.Signature
 module Time = Tezos_base.TzPervasives.Time
+module Memory_proto_alpha = X_memory_proto_alpha
+module Micheline = X_tezos_micheline
+
+module Error_monad = X_error_monad
+module Trace = Trace
+module PP = PP
+
 module List = X_list
 module Option = Tezos_base.TzPervasives.Option
 module Cast = Cast
-module Micheline = X_tezos_micheline
 module Tuple = Tuple
-
+module Map = X_map
-module Memory_proto_alpha = struct
+module Dictionary = Dictionary
-  include Memory_proto_alpha
+module Environment = Environment
-  let init_environment = Init_proto_alpha.init_environment
+module Tree = Tree
-  let dummy_environment = Init_proto_alpha.dummy_environment
-
-  open X_error_monad
-  open Script_typed_ir
-  open Script_ir_translator
-  open Script_interpreter
-
-  let stack_ty_eq (type a b)
-      ?(tezos_context = dummy_environment.tezos_context)
-      (a:a stack_ty) (b:b stack_ty) =
-    alpha_wrap (Script_ir_translator.stack_ty_eq tezos_context 0 a b) >>? fun (Eq, _) ->
-    ok Eq
-
-  let ty_eq (type a b)
-      ?(tezos_context = dummy_environment.tezos_context)
-      (a:a ty) (b:b ty)
-    =
-    alpha_wrap (Script_ir_translator.ty_eq tezos_context a b) >>? fun (Eq, _) ->
-    ok Eq
-
-  let parse_michelson (type aft)
-        ?(tezos_context = dummy_environment.tezos_context)
-        ?(top_level = Lambda) (michelson:Micheline.Michelson.t)
-        (bef:'a Script_typed_ir.stack_ty) (aft:aft Script_typed_ir.stack_ty)
-    =
-    let michelson = Micheline.Michelson.strip_annots michelson in
-    let michelson = Micheline.Michelson.strip_nops michelson in
-    parse_instr
-      top_level tezos_context
-      michelson bef >>=?? fun (j, _) ->
-    match j with
-    | Typed descr -> (
-      Lwt.return (
-          alpha_wrap (Script_ir_translator.stack_ty_eq tezos_context 0 descr.aft aft) >>? fun (Eq, _) ->
-          let descr : (_, aft) Script_typed_ir.descr = {descr with aft} in
-          Ok descr
-        )
-    )
-    | _ -> Lwt.return @@ error_exn (Failure "Typing instr failed")
-
-  let parse_michelson_data
-      ?(tezos_context = dummy_environment.tezos_context)
-      michelson ty =
-    let michelson = Micheline.Michelson.strip_annots michelson in
-    let michelson = Micheline.Michelson.strip_nops michelson in
-    parse_data tezos_context ty michelson >>=?? fun (data, _) ->
-    return data
-
-  let parse_michelson_ty
-      ?(tezos_context = dummy_environment.tezos_context)
-      ?(allow_big_map = true) ?(allow_operation = true)
-      michelson =
-    let michelson = Micheline.Michelson.strip_annots michelson in
-    let michelson = Micheline.Michelson.strip_nops michelson in
-    Lwt.return @@ parse_ty tezos_context ~allow_big_map ~allow_operation michelson >>=?? fun (ty, _) ->
-    return ty
-
-  let unparse_michelson_data
-      ?(tezos_context = dummy_environment.tezos_context)
-      ?mapper ty value : Micheline.Michelson.t tzresult Lwt.t =
-    Script_ir_translator.unparse_data tezos_context ?mapper
-      Readable ty value >>=?? fun (michelson, _) ->
-    return michelson
-
-  let interpret
-      ?(tezos_context = dummy_environment.tezos_context)
-      ?(source = (List.nth dummy_environment.identities 0).implicit_contract)
-      ?(self = (List.nth dummy_environment.identities 0).implicit_contract)
-      ?(payer = (List.nth dummy_environment.identities 1).implicit_contract)
-      ?visitor
-      (instr:('a, 'b) descr) (bef:'a stack) : 'b stack tzresult Lwt.t  =
-    Script_interpreter.step tezos_context ~source ~self ~payer ?visitor Alpha_context.Tez.one instr bef >>=??
-    fun (stack, _) -> return stack
-
-end

src/lib_utils/trace.ml

@@ -118,11 +118,11 @@ let bind_pair = bind_and
 let bind_map_pair f (a, b) =
   bind_pair (f a, f b)
 
-module AE = Tezos_utils.Memory_proto_alpha.Alpha_environment
+module AE = Memory_proto_alpha.Alpha_environment
 module TP = Tezos_base__TzPervasives
 
-let of_tz_error (err:Tezos_utils.Error_monad.error) : error =
+let of_tz_error (err:X_error_monad.error) : error =
-  let str = Tezos_utils.Error_monad.(to_string err) in
+  let str = X_error_monad.(to_string err) in
   error "alpha error" str
 
 let of_alpha_tz_error err = of_tz_error (AE.Ecoproto_error err)

src/lib_utils/x_list.ml

@@ -1,5 +1,16 @@
 include Tezos_base.TzPervasives.List
 
+let filter_map f =
+  let rec aux acc lst = match lst with
+    | [] -> List.rev acc
+    | hd :: tl -> aux (
+        match f hd with
+        | Some x -> x :: acc
+        | None -> acc
+      ) tl
+  in
+  aux []
+
 let range n =
   let rec aux acc n =
     if n = 0
@@ -53,3 +64,24 @@ let until n lst =
     else aux ((hd lst) :: acc) (n - 1) (tl lst)
   in
   rev (aux [] n lst)
+
+module Ne = struct
+
+  type 'a t = 'a * 'a list
+
+  let of_list lst = List.(hd lst, tl lst)
+  let to_list (hd, tl : _ t) = hd :: tl
+  let iter f (hd, tl : _ t) = f hd ; List.iter f tl
+  let map f (hd, tl : _ t) = f hd, List.map f tl
+  let mapi f (hd, tl : _ t) =
+    let lst = List.mapi f (hd::tl) in
+    of_list lst
+  let concat (hd, tl : _ t) = hd @ List.concat tl
+  let rev (hd, tl : _ t) =
+    match tl with
+    | [] -> (hd, [])
+    | lst ->
+        let r = List.rev lst in
+        (List.hd r, List.tl r @ [hd])
+
+end

src/lib_utils/x_map.ml

@@ -1,4 +1,14 @@
-module Make(Ord : Map.OrderedType) = struct
+module type OrderedType = Map.OrderedType
+
+module type S = sig
+  include Map.S
+
+  val of_list : (key * 'a) list -> 'a t
+  val to_list : 'a t -> 'a list
+  val to_kv_list : 'a t -> (key * 'a) list
+end
+
+module Make(Ord : Map.OrderedType) : S with type key = Ord.t = struct
   include Map.Make(Ord)
 
   let of_list (lst: (key * 'a) list) : 'a t =

src/lib_utils/x_memory_proto_alpha.ml

@@ -0,0 +1,77 @@
+module Michelson = X_tezos_micheline.Michelson
+
+include Memory_proto_alpha
+let init_environment = Init_proto_alpha.init_environment
+let dummy_environment = Init_proto_alpha.dummy_environment
+
+open X_error_monad
+open Script_typed_ir
+open Script_ir_translator
+open Script_interpreter
+
+let stack_ty_eq (type a b)
+    ?(tezos_context = dummy_environment.tezos_context)
+    (a:a stack_ty) (b:b stack_ty) =
+  alpha_wrap (Script_ir_translator.stack_ty_eq tezos_context 0 a b) >>? fun (Eq, _) ->
+  ok Eq
+
+let ty_eq (type a b)
+    ?(tezos_context = dummy_environment.tezos_context)
+    (a:a ty) (b:b ty)
+  =
+  alpha_wrap (Script_ir_translator.ty_eq tezos_context a b) >>? fun (Eq, _) ->
+  ok Eq
+
+let parse_michelson (type aft)
+    ?(tezos_context = dummy_environment.tezos_context)
+    ?(top_level = Lambda) (michelson:Michelson.t)
+    (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
+    top_level tezos_context
+    michelson bef >>=?? fun (j, _) ->
+  match j with
+  | Typed descr -> (
+      Lwt.return (
+        alpha_wrap (Script_ir_translator.stack_ty_eq tezos_context 0 descr.aft aft) >>? fun (Eq, _) ->
+        let descr : (_, aft) Script_typed_ir.descr = {descr with aft} in
+        Ok descr
+      )
+    )
+  | _ -> Lwt.return @@ error_exn (Failure "Typing instr failed")
+
+let parse_michelson_data
+    ?(tezos_context = dummy_environment.tezos_context)
+    michelson ty =
+  let michelson = Michelson.strip_annots michelson in
+  let michelson = Michelson.strip_nops michelson in
+  parse_data tezos_context ty michelson >>=?? fun (data, _) ->
+  return data
+
+let parse_michelson_ty
+    ?(tezos_context = dummy_environment.tezos_context)
+    ?(allow_big_map = true) ?(allow_operation = true)
+    michelson =
+  let michelson = Michelson.strip_annots michelson in
+  let michelson = Michelson.strip_nops michelson in
+  Lwt.return @@ parse_ty tezos_context ~allow_big_map ~allow_operation michelson >>=?? fun (ty, _) ->
+  return ty
+
+let unparse_michelson_data
+    ?(tezos_context = dummy_environment.tezos_context)
+    ?mapper ty value : Michelson.t tzresult Lwt.t =
+  Script_ir_translator.unparse_data tezos_context ?mapper
+    Readable ty value >>=?? fun (michelson, _) ->
+  return michelson
+
+let interpret
+    ?(tezos_context = dummy_environment.tezos_context)
+    ?(source = (List.nth dummy_environment.identities 0).implicit_contract)
+    ?(self = (List.nth dummy_environment.identities 0).implicit_contract)
+    ?(payer = (List.nth dummy_environment.identities 1).implicit_contract)
+    ?visitor
+    (instr:('a, 'b) descr) (bef:'a stack) : 'b stack tzresult Lwt.t  =
+  Script_interpreter.step tezos_context ~source ~self ~payer ?visitor Alpha_context.Tez.one instr bef >>=??
+  fun (stack, _) -> return stack

src/ligo/ast_simplified.ml

@@ -1,4 +1,4 @@
-module SMap = Ligo_helpers.X_map.String
+module SMap = Map.String
 
 type name = string
 type type_name = string
@@ -116,19 +116,22 @@ let ae expression = {expression ; type_annotation = None}
 
 let annotated_expression expression type_annotation = {expression ; type_annotation}
 
-open Ligo_helpers.Trace
+open Trace
 
 module PP = struct
-  open Ligo_helpers.PP
+  open PP
   open Format
 
+  let list_sep_d x = list_sep x (const " , ")
+  let smap_sep_d x = smap_sep x (const " , ")
+
   let rec type_expression ppf (te:type_expression) = match te with
-    | T_tuple lst -> fprintf ppf "tuple[%a]" (list_sep type_expression) lst
+    | T_tuple lst -> fprintf ppf "tuple[%a]" (list_sep_d type_expression) lst
-    | T_sum m -> fprintf ppf "sum[%a]" (smap_sep type_expression) m
+    | T_sum m -> fprintf ppf "sum[%a]" (smap_sep_d type_expression) m
-    | T_record m -> fprintf ppf "record[%a]" (smap_sep type_expression) m
+    | T_record m -> fprintf ppf "record[%a]" (smap_sep_d type_expression) m
     | T_function (p, r) -> fprintf ppf "%a -> %a" type_expression p type_expression r
     | T_variable name -> fprintf ppf "%s" name
-    | T_constant (name, lst) -> fprintf ppf "%s(%a)" name (list_sep type_expression) lst
+    | T_constant (name, lst) -> fprintf ppf "%s(%a)" name (list_sep_d type_expression) lst
 
   let literal ppf (l:literal) = match l with
     | Literal_unit -> fprintf ppf "Unit"
@@ -142,11 +145,11 @@ module PP = struct
     | E_variable name -> fprintf ppf "%s" name
     | E_application (f, arg) -> fprintf ppf "(%a)@(%a)" annotated_expression f annotated_expression arg
     | E_constructor (name, ae) -> fprintf ppf "%s(%a)" name annotated_expression ae
-    | E_constant (name, lst) -> fprintf ppf "%s(%a)" name (list_sep annotated_expression) lst
+    | E_constant (name, lst) -> fprintf ppf "%s(%a)" name (list_sep_d annotated_expression) lst
-    | E_tuple lst -> fprintf ppf "tuple[%a]" (list_sep annotated_expression) lst
+    | E_tuple lst -> fprintf ppf "tuple[%a]" (list_sep_d annotated_expression) lst
     | E_accessor (ae, p) -> fprintf ppf "%a.%a" annotated_expression ae access_path p
-    | E_record m -> fprintf ppf "record[%a]" (smap_sep annotated_expression) m
+    | E_record m -> fprintf ppf "record[%a]" (smap_sep_d annotated_expression) m
-    | E_map m -> fprintf ppf "map[%a]" (list_sep assoc_annotated_expression) m
+    | E_map m -> fprintf ppf "map[%a]" (list_sep_d assoc_annotated_expression) m
     | E_look_up (ds, ind) -> fprintf ppf "(%a)[%a]" annotated_expression ds annotated_expression ind
     | E_lambda {binder;input_type;output_type;result;body} ->
         fprintf ppf "lambda (%s:%a) : %a {%a} return %a"
@@ -164,7 +167,7 @@ module PP = struct
     | Access_record s -> fprintf ppf "%s" s
 
   and access_path ppf (p:access_path) =
-    fprintf ppf "%a" (list_sep ~pp_sep:(const ".") access) p
+    fprintf ppf "%a" (list_sep access (const ".")) p
 
   and type_annotation ppf (ta:type_expression option) = match ta with
     | None -> fprintf ppf ""
@@ -174,7 +177,7 @@ module PP = struct
     | None -> fprintf ppf "%a" expression ae.expression
     | Some t -> fprintf ppf "(%a) : %a" expression ae.expression type_expression t
 
-  and block ppf (b:block) = (list_sep instruction) ppf b
+  and block ppf (b:block) = (list_sep_d instruction) ppf b
 
   and single_record_patch ppf ((p, ae) : string * ae) =
     fprintf ppf "%s <- %a" p annotated_expression ae
@@ -182,7 +185,7 @@ module PP = struct
   and matching : type a . (formatter -> a -> unit) -> formatter -> a matching -> unit =
     fun f ppf m -> match m with
     | Match_tuple (lst, b) ->
-        fprintf ppf "let (%a) = %a" (list_sep (fun ppf -> fprintf ppf "%s")) lst f b
+        fprintf ppf "let (%a) = %a" (list_sep_d string) lst f b
     | Match_bool {match_true ; match_false} ->
         fprintf ppf "| True -> %a @.| False -> %a" f match_true f match_false
     | Match_list {match_nil ; match_cons = (hd, tl, match_cons)} ->
@@ -193,7 +196,7 @@ module PP = struct
   and instruction ppf (i:instruction) = match i with
     | I_skip -> fprintf ppf "skip"
     | I_fail ae -> fprintf ppf "fail with (%a)" annotated_expression ae
-    | I_record_patch (name, path, lst) -> fprintf ppf "%s.%a[%a]" name access_path path (list_sep single_record_patch) lst
+    | I_record_patch (name, path, lst) -> fprintf ppf "%s.%a[%a]" name access_path path (list_sep_d single_record_patch) lst
     | I_loop (cond, b) -> fprintf ppf "while (%a) { %a }" annotated_expression cond block b
     | I_assignment {name;annotated_expression = ae} ->
         fprintf ppf "%s := %a" name annotated_expression ae
@@ -207,7 +210,7 @@ module PP = struct
         fprintf ppf "const %s = %a" name annotated_expression ae
 
   let program ppf (p:program) =
-    fprintf ppf "%a" (list_sep declaration) p
+    fprintf ppf "%a" (list_sep_d declaration) p
 end
 
 module Rename = struct

src/ligo/ast_typed.ml

@@ -1,6 +1,6 @@
 module S = Ast_simplified
 
-module SMap = Ligo_helpers.X_map.String
+module SMap = Map.String
 
 type name = string
 type type_name = string
@@ -109,7 +109,7 @@ and matching_instr = b matching
 
 and matching_expr = ae matching
 
-open! Ligo_helpers.Trace
+open! Trace
 
 
 let type_value type_value simplified = { type_value ; simplified }
@@ -135,16 +135,20 @@ let get_functional_entry (p:program) (entry : string) : (lambda * type_value) re
 
 module PP = struct
   open Format
-  open Ligo_helpers.PP
+  open PP
+
+  let list_sep_d x = list_sep x (const " , ")
+  let smap_sep_d x = smap_sep x (const " , ")
+
 
   let rec type_value' ppf (tv':type_value') : unit =
     match tv' with
-    | T_tuple lst -> fprintf ppf "tuple[%a]" (list_sep type_value) lst
+    | T_tuple lst -> fprintf ppf "tuple[%a]" (list_sep_d type_value) lst
-    | T_sum m -> fprintf ppf "sum[%a]" (smap_sep type_value) m
+    | T_sum m -> fprintf ppf "sum[%a]" (smap_sep_d type_value) m
-    | T_record m -> fprintf ppf "record[%a]" (smap_sep type_value) m
+    | T_record m -> fprintf ppf "record[%a]" (smap_sep_d type_value) m
     | T_function (a, b) -> fprintf ppf "%a -> %a" type_value a type_value b
     | T_constant (c, []) -> fprintf ppf "%s" c
-    | T_constant (c, n) -> fprintf ppf "%s(%a)" c (list_sep type_value) n
+    | T_constant (c, n) -> fprintf ppf "%s(%a)" c (list_sep_d type_value) n
 
   and type_value ppf (tv:type_value) : unit =
     type_value' ppf tv.type_value
@@ -157,19 +161,19 @@ module PP = struct
   and expression ppf (e:expression) : unit =
     match e with
     | E_literal l -> literal ppf l
-    | E_constant (c, lst) -> fprintf ppf "%s(%a)" c (list_sep annotated_expression) lst
+    | E_constant (c, lst) -> fprintf ppf "%s(%a)" c (list_sep_d annotated_expression) lst
     | E_constructor (c, lst) -> fprintf ppf "%s(%a)" c annotated_expression lst
     | E_variable a -> fprintf ppf "%s" a
     | E_application (f, arg) -> fprintf ppf "(%a) (%a)" annotated_expression f annotated_expression arg
-    | E_tuple lst -> fprintf ppf "tuple[%a]" (list_sep annotated_expression) lst
+    | E_tuple lst -> fprintf ppf "tuple[%a]" (list_sep_d annotated_expression) lst
     | E_lambda {binder;input_type;output_type;result;body} ->
         fprintf ppf "lambda (%s:%a) : %a {%a} return %a"
           binder type_value input_type type_value output_type
           block body annotated_expression result
     | E_tuple_accessor (ae, i) -> fprintf ppf "%a.%d" annotated_expression ae i
     | E_record_accessor (ae, s) -> fprintf ppf "%a.%s" annotated_expression ae s
-    | E_record m -> fprintf ppf "record[%a]" (smap_sep annotated_expression) m
+    | E_record m -> fprintf ppf "record[%a]" (smap_sep_d annotated_expression) m
-    | E_map m -> fprintf ppf "map[%a]" (list_sep assoc_annotated_expression) m
+    | E_map m -> fprintf ppf "map[%a]" (list_sep_d assoc_annotated_expression) m
     | E_look_up (ds, i) -> fprintf ppf "(%a)[%a]" annotated_expression ds annotated_expression i
     | E_matching (ae, m) ->
         fprintf ppf "match %a with %a" annotated_expression ae (matching annotated_expression) m
@@ -186,14 +190,14 @@ module PP = struct
     | Literal_string s -> fprintf ppf "%s" s
     | Literal_bytes b -> fprintf ppf "0x%s" @@ Bytes.to_string @@ Bytes.escaped b
 
-  and block ppf (b:block) = (list_sep instruction) ppf b
+  and block ppf (b:block) = (list_sep_d instruction) ppf b
 
   and single_record_patch ppf ((s, ae) : string * ae) =
     fprintf ppf "%s <- %a" s annotated_expression ae
 
   and matching : type a . (formatter -> a -> unit) -> _ -> a matching -> unit = fun f ppf m -> match m with
     | Match_tuple (lst, b) ->
-        fprintf ppf "let (%a) = %a" (list_sep (fun ppf -> fprintf ppf "%s")) lst f b
+        fprintf ppf "let (%a) = %a" (list_sep_d (fun ppf -> fprintf ppf "%s")) lst f b
     | Match_bool {match_true ; match_false} ->
         fprintf ppf "| True -> %a @.| False -> %a" f match_true f match_false
     | Match_list {match_nil ; match_cons = (hd, tl, match_cons)} ->
@@ -216,7 +220,7 @@ module PP = struct
         fprintf ppf "const %s = %a" name annotated_expression ae
 
   let program ppf (p:program) =
-    fprintf ppf "%a" (list_sep declaration) p
+    fprintf ppf "%a" (list_sep_d declaration) p
 
 end
 

src/ligo/bin/dune

@@ -1,6 +1,9 @@
 (executable
   (name cli)
   (public_name ligo)
+  (libraries
+    tezos-utils
+  )
   (package ligo)
   (preprocess
     (pps ppx_let)

src/ligo/dune

@@ -1,18 +1,25 @@
+(env
+  (dev
+    (flags (:standard -w +1..62-4-9-44-40-42-48@39@33 -open Tezos_utils ))
+  )
+  (release
+    (flags (:standard -w +1..62-4-9-44-40-42-48@39@33 -open Tezos_utils ))
+  )
+)
+
 (library
   (name ligo)
   (public_name ligo)
   (libraries
     tezos-utils
     tezos-micheline
-    meta-michelson
+    meta_michelson
-    ligo_helpers
     ligo_parser
     multifix
   )
   (preprocess
     (pps ppx_let)
   )
-  (flags (:standard -w +1..62-4-9-44-40-42-48@39@33 ))
 )
 
 (alias

src/ligo/ligo.ml

@@ -9,7 +9,7 @@ module Mini_c = Mini_c
 module Typer = Typer
 module Transpiler = Transpiler
 
-open Ligo_helpers.Trace
+open Trace
 
 let parse_file (source: string) : AST_Raw.t result =
   let pp_input =

src/ligo/ligo_helpers/PP.ml

@@ -1,15 +0,0 @@
-open Format
-module SMap = X_map.String
-
-let const s ppf () = pp_print_string ppf s
-
-let list_sep ?(pp_sep = const " ; ") pp =
-  pp_print_list ~pp_sep pp
-
-
-let pair_sep pp ppf (a, b) = fprintf ppf "(%a, %a)" pp a pp b
-let smap_sep pp ppf m =
-  let aux k v prev = (k, v) :: prev in
-  let new_pp ppf (k, v) = fprintf ppf "%s -> %a" k pp v in
-  let lst = List.rev @@ SMap.fold aux m [] in
-  fprintf ppf "%a" (list_sep new_pp) lst

src/ligo/ligo_helpers/dictionary.ml

@@ -1,33 +0,0 @@
-open Trace
-
-type ('a, 'b) t = ('a * 'b) list
-
-let get_exn x y = List.assoc y x
-
-let get x y = generic_try (simple_error "Dictionry.get") @@ fun () -> get_exn x y
-
-let set ?equal lst a b =
-  let equal : 'a -> 'a -> bool =
-    Option.unopt
-      ~default:(=) equal
-  in
-  let rec aux acc = function
-    | [] -> List.rev acc
-    | (key, _)::tl when equal key a -> aux ((key, b) :: acc) tl
-    | hd::tl -> aux (hd :: acc) tl
-  in
-  aux [] lst
-
-let del ?equal lst a =
-  let equal : 'a -> 'a -> bool =
-    Option.unopt
-      ~default:(=) equal
-  in
-  let rec aux acc = function
-    | [] -> List.rev acc
-    | (key, _)::tl when equal key a -> aux acc tl
-    | hd::tl -> aux (hd :: acc) tl
-  in
-  aux [] lst
-
-let to_list x = x

src/ligo/ligo_helpers/dictionary.mli

@@ -1,16 +0,0 @@
-open Trace
-
-type ('a, 'b) t
-
-val get_exn : ('a, 'b) t -> 'a -> 'b
-val get : ('a, 'b) t -> 'a -> 'b result
-
-val set :
-  ?equal:('a -> 'a -> bool) ->
-  ('a, 'b) t -> 'a -> 'b -> ('a, 'b) t
-
-val del :
-  ?equal:('a -> 'a -> bool) ->
-  ('a, 'b) t -> 'a -> ('a, 'b) t
-
-val to_list : ('a, 'b) t -> ('a * 'b) list

src/ligo/ligo_helpers/dune

@@ -1,9 +0,0 @@
-(library
-  (name ligo_helpers)
-  (public_name ligo.helpers)
-  (libraries
-    tezos-base
-    tezos-utils
-  )
-;;  (modules x_map option wrap tree location environment dictionary PP trace)
-)

src/ligo/ligo_parser/dune

@@ -10,7 +10,15 @@
  (name ligo_parser)
  (public_name ligo.parser)
  (modules_without_implementation Error)
- (libraries getopt hex str uutf zarith))
+ (libraries
+   getopt
+   hex
+   str
+   uutf
+   zarith
+   tezos-utils
+ )
+)
 
 ;; Les deux directives (rule) qui suivent sont pour le dev local.
 ;; Il suffit de faire "dune build Parser.exe" pour avoir un Parser.exe dans le dossier.

src/ligo/meta-michelson/meta-michelson.opam

@@ -1,21 +0,0 @@
-name: "meta-michelson"
-opam-version: "2.0"
-version: "1.0"
-maintainer: "gabriel.alfour@gmail.com"
-authors: [ "Galfour" ]
-homepage: "https://gitlab.com/gabriel.alfour/tezos"
-bug-reports: "https://gitlab.com/gabriel.alfour/tezos/issues"
-dev-repo: "git+https://gitlab.com/gabriel.alfour/tezos.git"
-license: "MIT"
-depends: [
-  "ocamlfind" { build }
-  "dune" { build & >= "1.0.1" }
-  "tezos-utils"
-  "michelson-parser"
-]
-build: [
-  [ "dune" "build" "-p" name "-j" jobs ]
-]
-url {
-  src: "https://gitlab.com/gabriel.alfour/tezos/-/archive/master/tezos.tar.gz"
-}

src/ligo/meta_michelson/dune

@@ -1,6 +1,6 @@
 (library
  (name meta_michelson)
- (public_name meta-michelson)
+ (public_name ligo.meta_michelson)
  (libraries
    tezos-utils
    michelson-parser

src/ligo/mini_c.ml

@@ -1,4 +1,3 @@
-open Ligo_helpers
 open! Trace
 open Tezos_utils.Memory_proto_alpha
 
@@ -114,7 +113,9 @@ and program = toplevel_statement list
 
 module PP = struct
   open Format
-  open Ligo_helpers.PP
+  open PP
+
+  let list_sep_d x = list_sep x (const " , ")
 
   let space_sep ppf () = fprintf ppf " "
 
@@ -144,14 +145,14 @@ module PP = struct
 
   and environment_small' ppf e' = let open Append_tree in
     let lst = to_list' e' in
-    fprintf ppf "S[%a]" (list_sep environment_element) lst
+    fprintf ppf "S[%a]" (list_sep_d environment_element) lst
 
   and environment_small ppf e = let open Append_tree in
     let lst = to_list e in
-    fprintf ppf "S[%a]" (list_sep environment_element) lst
+    fprintf ppf "S[%a]" (list_sep_d environment_element) lst
 
   let environment ppf (x:environment) =
-    fprintf ppf "Env[%a]" (list_sep environment_small) x
+    fprintf ppf "Env[%a]" (list_sep_d environment_small) x
 
   let rec value ppf : value -> unit = function
     | D_bool b -> fprintf ppf "%b" b
@@ -166,7 +167,7 @@ module PP = struct
     | D_function x -> function_ ppf x.content
     | D_none -> fprintf ppf "None"
     | D_some s -> fprintf ppf "Some (%a)" value s
-    | D_map m -> fprintf ppf "Map[%a]" (list_sep value_assoc) m
+    | D_map m -> fprintf ppf "Map[%a]" (list_sep_d value_assoc) m
 
   and value_assoc ppf : (value * value) -> unit = fun (a, b) ->
     fprintf ppf "%a -> %a" value a value b

src/ligo/multifix/dune

@@ -43,6 +43,7 @@
   (name generator)
   (libraries
     ocamlgraph
+    tezos-utils
     lex
   )
   (modules generator)

src/ligo/multifix/generator.ml

@@ -1,61 +1,12 @@
-module N = struct
+type 'a name = {
-  type 'a t = {
   content : 'a ;
   name : string ;
-  }
+}
 
-  let name name content = { name ; content }
+let make_name name content = { name ; content }
-  let destruct {name ; content} = (name, content)
+let destruct {name ; content} = (name, content)
-  let get_name x = x.name
+let get_name x = x.name
-  let get_content x = x.content
+let get_content x = x.content
-end
-
-let list_filter_map f =
-  let rec aux acc lst = match lst with
-    | [] -> List.rev acc
-    | hd :: tl -> aux (
-        match f hd with
-        | Some x -> x :: acc
-        | None -> acc
-      ) tl
-  in
-  aux []
-
-module Ne_list = struct
-  type 'a t = 'a * 'a list
-
-  let of_list lst = List.(hd lst, tl lst)
-  let iter f (hd, tl : _ t) = f hd ; List.iter f tl
-  let map f (hd, tl : _ t) = f hd, List.map f tl
-  let mapi f (hd, tl : _ t) =
-    let lst = List.mapi f (hd::tl) in
-    of_list lst
-  let concat (hd, tl : _ t) = hd @ List.concat tl
-  let rev (hd, tl : _ t) =
-    match tl with
-    | [] -> (hd, [])
-    | lst ->
-      let r = List.rev lst in
-      (List.hd r, List.tl r @ [hd])
-end
-
-module PP = struct
-  open Format
-  let string : formatter -> string -> unit = fun ppf s -> fprintf ppf "%s" s
-  let tag tag : formatter -> unit -> unit = fun ppf () -> fprintf ppf tag
-  let new_line : formatter -> unit -> unit = tag "@;"
-  let rec new_lines n ppf () =
-    match n with
-    | 0 -> new_line ppf ()
-    | n -> new_line ppf () ; new_lines (n-1) ppf ()
-  let const const : formatter -> unit -> unit = fun ppf () -> fprintf ppf "%s" const
-  let comment : formatter -> string -> unit = fun ppf s -> fprintf ppf "(* %s *)" s
-  let list_sep value separator = pp_print_list ~pp_sep:separator value
-  let ne_list_sep value separator ppf (hd, tl) =
-    value ppf hd ;
-    separator ppf () ;
-    pp_print_list ~pp_sep:separator value ppf tl
-end
 
 module Token = Lex.Token
 type token = Token.token
@@ -70,13 +21,13 @@ module O = struct
     | Lower (* Lower precedence *)
 
   type operator = element list
-  type n_operator = operator N.t
+  type n_operator = operator name
 
   type n_operators = n_operator list
-  type level = n_operators N.t
+  type level = n_operators name
 
-  type hierarchy = level Ne_list.t
+  type hierarchy = level List.Ne.t
-  type n_hierarchy = hierarchy N.t
+  type n_hierarchy = hierarchy name
 
   type singleton = {
     type_name : string ;
@@ -91,17 +42,17 @@ module O = struct
     hierarchies : n_hierarchy list ;
   }
 
-  let get_op : n_operator -> operator = N.get_content
+  let get_op : n_operator -> operator = get_content
 
   let singleton type_name type_expression menhir_rule menhir_code =
     {type_name ; type_expression ; menhir_rule ; menhir_code}
   let language entry_point singletons hierarchies = {entry_point ; singletons ; hierarchies}
 
   let name_hierarchy name : n_operators list -> n_hierarchy = fun nopss ->
-    let nopss' = Ne_list.of_list nopss in
+    let nopss' = List.Ne.of_list nopss in
-    let name_i = fun i x -> N.name (name ^ "_" ^ (string_of_int i)) x in
+    let name_i = fun i x -> make_name (name ^ "_" ^ (string_of_int i)) x in
-    let levels : hierarchy = Ne_list.mapi name_i nopss' in
+    let levels : hierarchy = List.Ne.mapi name_i nopss' in
-    N.name name levels
+    make_name name levels
 
 end
 
@@ -120,15 +71,15 @@ module Check = struct
       in
       (if (List.length es < 2) then raise (Failure "operator is too short")) ;
       aux es in
-    let op : n_operator -> unit = fun x -> elements @@ N.get_content x in
+    let op : n_operator -> unit = fun x -> elements @@ get_content x in
-    let level : level -> unit = fun l -> List.iter op @@ N.get_content l in
+    let level : level -> unit = fun l -> List.iter op @@ get_content l in
-    let hierarchy : n_hierarchy -> unit = fun h -> Ne_list.iter level @@ N.get_content h in
+    let hierarchy : n_hierarchy -> unit = fun h -> List.Ne.iter level @@ get_content h in
     List.iter hierarchy l.hierarchies
 
   let associativity : language -> unit = fun l ->
     let level : level -> unit = fun l ->
       let aux : ([`Left | `Right | `None] as 'a) -> n_operator -> 'a = fun ass nop ->
-        let op = N.get_content nop in
+        let op = get_content nop in
         match ass, List.hd op, List.nth op (List.length op - 1) with
         | _, Lower, Lower -> raise (Failure "double assoc")
         | `None, Lower, _ -> `Left
@@ -137,11 +88,11 @@ module Check = struct
         | `Right, Lower, _ -> raise (Failure "different assocs")
         | m, _, _ -> m
       in
-      let _assert = List.fold_left aux `None (N.get_content l) in
+      let _assert = List.fold_left aux `None (get_content l) in
       ()
     in
     let hierarchy : n_hierarchy -> unit = fun h ->
-      Ne_list.iter level (N.get_content h) in
+      List.Ne.iter level (get_content h) in
     List.iter hierarchy l.hierarchies
 
 end
@@ -161,16 +112,16 @@ module Print_AST = struct
         | List _ -> Some ("(" ^ level_name ^ " Location.wrap list)")
         | Token _ -> None
         | Current | Lower -> Some (level_name ^ " Location.wrap") in
-      list_filter_map aux (N.get_content nop) in
+      List.filter_map aux (get_content nop) in
     let type_element = fun ppf te -> fprintf ppf "%s" te in
     fprintf ppf "| %s of (%a)"
-      (N.get_name nop)
+      (get_name nop)
       PP.(list_sep type_element (const " * ")) type_elements
 
   let n_hierarchy : _ -> O.n_hierarchy -> _ = fun ppf nh ->
-    let levels = Ne_list.map N.get_content (N.get_content nh) in
+    let levels = List.Ne.map get_content (get_content nh) in
-    let nops = Ne_list.concat levels in
+    let nops = List.Ne.concat levels in
-    let name = N.get_name nh in
+    let name = get_name nh in
     fprintf ppf "type %s =@.@[%a@]"
       name
       PP.(list_sep (n_operator name) new_line) nops
@@ -214,10 +165,10 @@ module Print_Grammar = struct
       ) ;
       i := !i + 1
     in
-    PP.(list_sep element (const " ")) ppf (N.get_content nop)
+    PP.(list_sep element (const " ")) ppf (get_content nop)
 
   let n_operator_code : _ -> O.n_operator -> _ = fun ppf nop ->
-    let (name, elements) = N.destruct nop in
+    let (name, elements) = destruct nop in
     let elements' =
       let i = ref 0 in
       let aux : O.element -> _ = fun e ->
@@ -227,39 +178,39 @@ module Print_Grammar = struct
           | List _ | Named _ | Current | Lower -> Some letters.(!i)
         in i := !i + 1 ; r
       in
-      list_filter_map aux elements in
+      List.filter_map aux elements in
     fprintf ppf "%s (%a)" name PP.(list_sep string (const " , ")) elements'
 
   let n_operator prev_lvl_name cur_lvl_name : _ -> O.n_operator -> _ = fun ppf nop ->
-    let name = N.get_name nop in
+    let name = get_name nop in
     fprintf ppf "%a@;| %a@;  @[<v>{@;  @[let loc = Location.make $startpos $endpos in@;Location.wrap ~loc %@%@ %a@]@;}@]" PP.comment name
       (n_operator_rule prev_lvl_name cur_lvl_name) nop
       n_operator_code nop
 
   let level prev_lvl_name : _ -> O.level -> _ = fun ppf l ->
-    let name = N.get_name l in
+    let name = get_name l in
     match prev_lvl_name with
     | "" -> (
         fprintf ppf "%s :@.  @[<v>%a@]" name
-          PP.(list_sep (n_operator prev_lvl_name name) new_line) (N.get_content l) ;
+          PP.(list_sep (n_operator prev_lvl_name name) new_line) (get_content l) ;
       )
     | _ -> (
         fprintf ppf "%s :@.  @[<v>%a@;| %s { $1 }@]" name
-          PP.(list_sep (n_operator prev_lvl_name name) new_line) (N.get_content l)
+          PP.(list_sep (n_operator prev_lvl_name name) new_line) (get_content l)
           prev_lvl_name
       )
 
   let n_hierarchy : _ -> O.n_hierarchy -> _ = fun ppf nh ->
-    let name = N.get_name nh in
+    let name = get_name nh in
     fprintf ppf "%a@.%%inline %s : %s_0 { $1 }@.@;" PP.comment ("Top-level for " ^ name) name name;
-    let (hd, tl) = Ne_list.rev @@ N.get_content nh in
+    let (hd, tl) = List.Ne.rev @@ get_content nh in
     fprintf ppf "%a" (level "") hd ;
     let aux prev_name lvl =
       PP.new_lines 2 ppf () ;
       fprintf ppf "%a" (level prev_name) lvl ;
-      N.get_name lvl
+      get_name lvl
     in
-    let _last_name = List.fold_left aux (N.get_name hd) tl in
+    let _last_name = List.fold_left aux (get_name hd) tl in
     ()
 
   let language : _ -> O.language -> _ = fun ppf l ->
@@ -277,14 +228,14 @@ let variable = O.singleton "variable" "string" "NAME" "$1"
 let infix : string -> [`Left | `Right] -> token -> O.n_operator = fun name assoc t ->
   let open O in
   match assoc with
-  | `Left -> N.name name [Current ; Token t ; Lower]
+  | `Left -> make_name name [Current ; Token t ; Lower]
-  | `Right -> N.name name [Current ; Token t ; Lower]
+  | `Right -> make_name name [Current ; Token t ; Lower]
 
-let list = N.name "List" [
+let list = make_name "List" [
     O.Token Token.LIST ; List (`Lead, Token.LSQUARE, Token.SEMICOLON, Token.RSQUARE) ;
 ]
 
-let let_in : O.n_operator = N.name "Let_in" [
+let let_in : O.n_operator = make_name "Let_in" [
     O.Token Token.LET ; Named "variable" ;
     O.Token Token.EQUAL ; Current ;
     O.Token Token.IN ; Current ;
@@ -296,7 +247,7 @@ let substraction = infix "Substraction" `Left Token.MINUS
 let multiplication = infix "Multiplication" `Left Token.TIMES
 let division = infix "Division" `Left Token.DIV
 
-let arith_variable : O.n_operator = N.name "Arith_variable" [ O.Named "variable" ]
+let arith_variable : O.n_operator = make_name "Arith_variable" [ O.Named "variable" ]
 
 let arith = O.name_hierarchy "arith" [
     [let_in] ;

src/ligo/multifix/lex/dune

@@ -1,6 +1,9 @@
 (library
   (name lex)
   (public_name ligo.multifix.lex)
+  (libraries
+    tezos-utils
+  )
   (modules token token_type lexer)
 )
 

src/ligo/simplify.ml

@@ -1,4 +1,4 @@
-open Ligo_helpers.Trace
+open Trace
 open Ast_simplified
 module Raw = Ligo_parser.AST
 

src/ligo/simplify_mixfix.ml

@@ -0,0 +1,2 @@
+(* open Trace
+ * open Multifix.User *)

src/ligo/transpiler.ml

@@ -1,12 +1,12 @@
-open! Ligo_helpers.Trace
+open! Trace
 open Mini_c
 open Combinators
 
 module AST = Ast_typed
 open AST.Combinators
 
-let list_of_map m = List.rev @@ Ligo_helpers.X_map.String.fold (fun _ v prev -> v :: prev) m []
+let list_of_map m = List.rev @@ Map.String.fold (fun _ v prev -> v :: prev) m []
-let kv_list_of_map m = List.rev @@ Ligo_helpers.X_map.String.fold (fun k v prev -> (k, v) :: prev) m []
+let kv_list_of_map m = List.rev @@ Map.String.fold (fun k v prev -> (k, v) :: prev) m []
 let map_of_kv_list lst =
   let open AST.SMap in
   List.fold_left (fun prev (k, v) -> add k v prev) empty lst

src/ligo/typer.ml

@@ -1,4 +1,4 @@
-open Ligo_helpers.Trace
+open Trace
 
 module I = Ast_simplified
 module O = Ast_typed
@@ -38,15 +38,17 @@ module Environment = struct
 
   module PP = struct
     open Format
-    open Ligo_helpers.PP
+    open PP
+
+    let list_sep_d x = list_sep x (const " , ")
 
     let value ppf (e:t) =
       let pp ppf (s, e) = fprintf ppf "%s -> %a" s O.PP.type_value e in
-      fprintf ppf "ValueEnv[%a]" (list_sep pp) e.environment
+      fprintf ppf "ValueEnv[%a]" (list_sep_d pp) e.environment
 
     let type_ ppf e =
       let pp ppf (s, e) = fprintf ppf "%s -> %a" s O.PP.type_value e in
-      fprintf ppf "TypeEnv[%a]" (list_sep pp) e.type_environment
+      fprintf ppf "TypeEnv[%a]" (list_sep_d pp) e.type_environment
 
     let full ppf e =
       fprintf ppf "%a\n%a" value e type_ e