Merge branch 'rinderknecht@pprint_comments' into 'dev'

Refactoring of the build of the front-end

See merge request ligolang/ligo!698

src/bin/expect_tests/transpiler_test.ml

@@ -676,26 +676,26 @@ let%expect_test _ =
 
     type entrypointReturn is list (operation) * storage
 
-    const errorTokenUndefined  = "TOKEN_UNDEFINED"
+    const errorTokenUndefined = "TOKEN_UNDEFINED"
 
-    const errorNotOwner  = "NOT_OWNER"
+    const errorNotOwner = "NOT_OWNER"
 
-    const errorInsufficientBalance  = "INSUFFICIENT_BALANCE"
+    const errorInsufficientBalance = "INSUFFICIENT_BALANCE"
 
     type transferContentsIteratorAccumulator is
       storage * tokenOwner
 
     function transferContentsIterator
-      (const gen__P
+      (const gen__P :
-         : transferContentsIteratorAccumulator *
+         transferContentsIteratorAccumulator *
          transferContentsMichelson) is
     block {
-      const gen__rhs1  = gen__P;
+      const gen__rhs1 = gen__P;
-      const accumulator  = gen__rhs1.0;
+      const accumulator = gen__rhs1.0;
-      const transferContentsMichelson  = gen__rhs1.1;
+      const transferContentsMichelson = gen__rhs1.1;
-      const gen__rhs2  = accumulator;
+      const gen__rhs2 = accumulator;
-      const storage  = gen__rhs2.0;
+      const storage = gen__rhs2.0;
-      const from_  = gen__rhs2.1;
+      const from_ = gen__rhs2.1;
       const transferContents
       = (Layout.convert_from_right_comb
            (transferContentsMichelson)
@@ -726,37 +726,37 @@ let%expect_test _ =
     function transferIterator
       (const gen__P : storage * transferMichelson) is
     block {
-      const gen__rhs7  = gen__P;
+      const gen__rhs7 = gen__P;
-      const storage  = gen__rhs7.0;
+      const storage = gen__rhs7.0;
-      const transferMichelson  = gen__rhs7.1;
+      const transferMichelson = gen__rhs7.1;
       const transferAuxiliary2
       = (Layout.convert_from_right_comb (transferMichelson)
          : transferAuxiliary);
-      const from_  = (transferAuxiliary2.from_ : tokenOwner);
+      const from_ = (transferAuxiliary2.from_ : tokenOwner);
       allowOnlyOwnTransfer (from_);
       const gen__rhs10
       = List.fold
           (transferContentsIterator, transferAuxiliary2.txs,
            (storage, from_));
-      const storage  = gen__rhs10.0;
+      const storage = gen__rhs10.0;
-      const _  = gen__rhs10.1
+      const _ = gen__rhs10.1
     } with storage
 
     function transfer
       (const gen__P : transferParameter * storage) is
     block {
-      const gen__rhs11  = gen__P;
+      const gen__rhs11 = gen__P;
-      const transferParameter  = gen__rhs11.0;
+      const transferParameter = gen__rhs11.0;
-      const storage  = gen__rhs11.1;
+      const storage = gen__rhs11.1;
       const storage
       = List.fold (transferIterator, transferParameter, storage)
     } with ((list [] : list (operation)), storage)
 
     function main (const gen__P : entrypointParameter) is
     block {
-      const gen__rhs13  = gen__P;
+      const gen__rhs13 = gen__P;
-      const parameter  = gen__rhs13.0;
+      const parameter = gen__rhs13.0;
-      const storage  = gen__rhs13.1
+      const storage = gen__rhs13.1
     } with
         case parameter of [
           Transfer (transferParameter) ->
@@ -1086,7 +1086,7 @@ let%expect_test _ =
             = if EQ (Tezos.sender, p.address_from)
               then
                 block {
-                  const new_allowances  = s.allowances;
+                  const new_allowances = s.allowances;
                   gen__env9.new_allowances := new_allowances;
                   skip
                 } with gen__env9
@@ -1127,14 +1127,14 @@ let%expect_test _ =
                   gen__env9.new_allowances := new_allowances;
                   skip
                 } with gen__env9;
-            const new_allowances  = gen__env9.new_allowances;
+            const new_allowances = gen__env9.new_allowances;
             const sender_balance : nat
             = case Map.find_opt (p.address_from, s.tokens) of [
                 Some (value) -> value
               | None -> 0n
               ];
             const new_tokens : tokens = big_map [];
-            const gen__env12  = record [new_tokens = new_tokens];
+            const gen__env12 = record [new_tokens = new_tokens];
             const gen__env12
             = if LT (sender_balance, p.value)
               then
@@ -1164,7 +1164,7 @@ let%expect_test _ =
                   gen__env12.new_tokens := new_tokens;
                   skip
                 } with gen__env12;
-            const new_tokens  = gen__env12.new_tokens
+            const new_tokens = gen__env12.new_tokens
           } with
               ((list [] : list (operation)),
                s with
@@ -1205,7 +1205,7 @@ let%expect_test _ =
                   gen__env14.new_allowances := new_allowances;
                   skip
                 } with gen__env14;
-            const new_allowances  = gen__env14.new_allowances
+            const new_allowances = gen__env14.new_allowances
           } with
               ((list [] : list (operation)),
                s with
@@ -1801,22 +1801,22 @@ let%expect_test _ =
     function foobar (const i : int) : int is
     block {
       const p : parameter = (Zero (42n));
-      const gen__env7  = record [i = i];
+      const gen__env7 = record [i = i];
       const gen__env7
       = if GT (i, 0)
         then
           block {
-            const i  = ADD (i, 1);
+            const i = ADD (i, 1);
             gen__env7.i := i;
-            const gen__env5  = record [i = i];
+            const gen__env5 = record [i = i];
             const gen__env5
             = if GT (i, 10)
               then
                 block {
-                  const i  = 20;
+                  const i = 20;
                   gen__env5.i := i;
                   failwith ("who knows");
-                  const i  = 30;
+                  const i = 30;
                   gen__env5.i := i;
                   skip
                 } with gen__env5
@@ -1824,7 +1824,7 @@ let%expect_test _ =
                 block {
                   skip
                 } with gen__env5;
-            const i  = gen__env5.i;
+            const i = gen__env5.i;
             gen__env7.i := i;
             skip
           } with gen__env7
@@ -1835,7 +1835,7 @@ let%expect_test _ =
             | Pos (n) -> skip
             ]
           } with gen__env7;
-      const i  = gen__env7.i
+      const i = gen__env7.i
     } with
         case p of [
           Zero (n) -> i

src/passes/01-parsing/cameligo.ml

@@ -1,11 +1,12 @@
 module CST      = Cst.Cameligo
-module LexToken = Parser_cameligo.LexToken
+module LexToken = Lexer_cameligo.LexToken
-module Lexer    = Lexer.Make(LexToken)
+module Lexer    = Lexer_shared.Lexer.Make (LexToken)
 module Scoping  = Parser_cameligo.Scoping
 module Region   = Simple_utils.Region
 module ParErr   = Parser_cameligo.ParErr
 module SSet     = Set.Make (String)
 module Pretty   = Parser_cameligo.Pretty
+module EvalOpt  = Lexer_shared.EvalOpt
 
 (* Mock IOs TODO: Fill them with CLI options *)
 

src/passes/01-parsing/cameligo/.links

@@ -5,17 +5,24 @@ $HOME/git/OCaml-build/Makefile
 ../shared/LexerLib.ml
 ../shared/EvalOpt.ml
 ../shared/EvalOpt.mli
-../shared/FQueue.ml
-../shared/FQueue.mli
 ../shared/LexerLog.mli
 ../shared/LexerLog.ml
 ../shared/Markup.ml
 ../shared/Markup.mli
-../shared/Utils.mli
-../shared/Utils.ml
 ../shared/ParserAPI.mli
 ../shared/ParserAPI.ml
 ../shared/LexerUnit.mli
 ../shared/LexerUnit.ml
 ../shared/ParserUnit.mli
 ../shared/ParserUnit.ml
+
+./Stubs/Lexer_shared.ml
+./Stubs/Lexer_cameligo.ml
+./Stubs/Parser_shared.ml
+./Stubs/Parser_cameligo.ml
+./Stubs/Cst.ml
+./Stubs/Cst_cameligo.ml
+
+$HOME/git/ligo/src/stages/1-cst/cameligo/CST.ml
+$HOME/git/ligo/src/stages/1-cst/cameligo/ParserLog.mli
+$HOME/git/ligo/src/stages/1-cst/cameligo/ParserLog.ml

src/passes/01-parsing/cameligo/LexToken.mli

@@ -21,13 +21,16 @@
    aliased to [token].
 *)
 
+(* Dependencies *)
+
 module Region = Simple_utils.Region
 module Pos    = Simple_utils.Pos
-
+module Markup = Lexer_shared.Markup
-type lexeme = string
 
 (* TOKENS *)
 
+type lexeme = string
+
 type t =
   (* Identifiers, labels, numbers and strings *)
 

src/passes/01-parsing/cameligo/LexToken.mll

@@ -1,17 +1,19 @@
+(* ocamlex specification for CameLIGO *)
 {
-  (* START HEADER *)
+(* START HEADER *)
 
-type lexeme = string
+(* Dependencies *)
-
-let sprintf = Printf.sprintf
 
 module Region = Simple_utils.Region
 module Pos    = Simple_utils.Pos
-module SMap   = Utils.String.Map
+module Markup = Lexer_shared.Markup
-module SSet   = Utils.String.Set
+module SMap   = Map.Make (String)
+module SSet   = Set.Make (String)
 
 (* TOKENS *)
 
+type lexeme = string
+
 type t =
   (* Identifiers, labels, numbers and strings *)
 
@@ -107,6 +109,8 @@ type t =
 
 (* Projections *)
 
+let sprintf = Printf.sprintf
+
 type token = t
 
 let proj_token = function

src/passes/01-parsing/cameligo/LexerMain.ml

@@ -1,6 +1,14 @@
 (* Driver for the CameLIGO lexer *)
 
-module Region = Simple_utils.Region
+(* Dependencies *)
+
+module Region    = Simple_utils.Region
+module EvalOpt   = Lexer_shared.EvalOpt
+module Lexer     = Lexer_shared.Lexer
+module LexerUnit = Lexer_shared.LexerUnit
+module LexToken  = Lexer_cameligo.LexToken
+
+(* Input/Output *)
 
 module IO =
   struct

src/passes/01-parsing/cameligo/ParToken.mly

@@ -1,4 +1,5 @@
 %{
+module LexToken = Lexer_cameligo.LexToken
 %}
 
 (* Tokens (mirroring thise defined in module LexToken) *)

src/passes/01-parsing/cameligo/Parser.mly

@@ -15,8 +15,8 @@ open CST
 (* Entry points *)
 
 %start contract interactive_expr
-%type <Cst.Cameligo.t> contract
+%type <CST.t> contract
-%type <Cst.Cameligo.expr> interactive_expr
+%type <CST.expr> interactive_expr
 
 %%
 

src/passes/01-parsing/cameligo/ParserMain.ml

@@ -1,7 +1,16 @@
 (* Driver for the CameLIGO parser *)
 
-module Region = Simple_utils.Region
+(* Dependencies *)
-module SSet   = Set.Make (String)
+
+module Region     = Simple_utils.Region
+module EvalOpt    = Lexer_shared.EvalOpt
+module LexToken   = Lexer_cameligo.LexToken
+module CST        = Cst.Cameligo
+module SSet       = Set.Make (String)
+module ParserUnit = Parser_shared.ParserUnit
+module Pretty     = Parser_cameligo.Pretty
+
+(* Input/Output *)
 
 module IO =
   struct
@@ -55,22 +64,22 @@ module SubIO =
 
 module Parser =
   struct
-    type ast  = AST.t
+    type ast  = CST.t
-    type expr = AST.expr
+    type expr = CST.expr
-    include Parser
+    include Parser_cameligo.Parser
   end
 
 module ParserLog =
   struct
-    type ast  = AST.t
+    type ast  = CST.t
-    type expr = AST.expr
+    type expr = CST.expr
-    include ParserLog
+    include Cst_cameligo.ParserLog
   end
 
-module Lexer = Lexer.Make (LexToken)
+module Lexer = Lexer_shared.Lexer.Make (LexToken)
 
 module Unit =
-  ParserUnit.Make (Lexer)(AST)(Parser)(Parser_msg)(ParserLog)(SubIO)
+  ParserUnit.Make (Lexer)(CST)(Parser)(Parser_msg)(ParserLog)(SubIO)
 
 (* Main *)
 

src/passes/01-parsing/cameligo/Pretty.ml

@@ -1,10 +1,11 @@
 [@@@warning "-42"]
 
-module CST=Cst.Cameligo
+module CST = Cst.Cameligo
 open CST
 module Region = Simple_utils.Region
 open! Region
 open! PPrint
+module Option = Simple_utils.Option
 
 let pp_par printer {value; _} =
   string "(" ^^ nest 1 (printer value.inside ^^ string ")")

src/passes/01-parsing/cameligo/README.txt

@@ -0,0 +1,2 @@
+Note: The files Scoping.mli and Scoping.ml are the destination of
+symbolic links from ../reasonligo.

src/passes/01-parsing/cameligo/Scoping.ml

@@ -1,7 +1,9 @@
 [@@@warning "-42"]
 
+(* Dependencies *)
+
 module Region = Simple_utils.Region
-module CST = Cst.Cameligo
+module CST    = Cst.Cameligo
 
 type t =
   Reserved_name      of CST.variable
@@ -17,7 +19,7 @@ open Region
 
 (* Useful modules *)
 
-module SSet = Utils.String.Set
+module SSet = Set.Make (String)
 
 module Ord =
   struct

src/passes/01-parsing/cameligo/Stubs/Cst.ml

@@ -0,0 +1 @@
+module Cameligo = CST

src/passes/01-parsing/cameligo/Stubs/Cst_cameligo.ml

@@ -0,0 +1 @@
+module ParserLog = ParserLog

src/passes/01-parsing/cameligo/Stubs/Lexer_cameligo.ml

@@ -0,0 +1 @@
+module LexToken = LexToken

src/passes/01-parsing/cameligo/Stubs/Lexer_shared.ml

@@ -0,0 +1,6 @@
+module EvalOpt   = EvalOpt
+module Markup    = Markup
+module Lexer     = Lexer
+module LexerUnit = LexerUnit
+module LexerLog  = LexerLog
+module LexerLib  = LexerLib

src/passes/01-parsing/cameligo/Stubs/Parser_cameligo.ml

@@ -0,0 +1,2 @@
+module Pretty = Pretty
+module Parser = Parser

src/passes/01-parsing/cameligo/Stubs/Parser_shared.ml

@@ -0,0 +1 @@
+module ParserUnit = ParserUnit

src/passes/01-parsing/cameligo/cameligo.ml

@@ -1,3 +0,0 @@
-module Parser = Parser
-module Lexer = Lexer
-module LexToken = LexToken

src/passes/01-parsing/cameligo/dune

@@ -1,13 +1,48 @@
+;; --------------------------------------------------------------------
+;; LEXING
+
 ;; Build of the lexer
 
 (ocamllex LexToken)
 
+;; Build of the lexer as a library
+
+(library
+  (name lexer_cameligo)
+  (public_name ligo.lexer.cameligo)
+  (modules LexToken)
+  (libraries
+    ;; Ligo
+    lexer_shared
+    ;; Third party
+    hex)
+  (preprocess
+    (pps bisect_ppx --conditional)))
+
+;; Build of a standalone lexer
+
+(executable
+  (name LexerMain)
+  (libraries
+    ;; Ligo
+    lexer_shared
+    lexer_cameligo
+    ;; Third party
+    hex)
+  (modules LexerMain)
+  (preprocess
+    (pps bisect_ppx --conditional)))
+
+;; --------------------------------------------------------------------
+;; PARSING
+
 ;; Build of the parser
 
 (menhir
   (merge_into Parser)
   (modules ParToken Parser)
-  (flags -la 1 --table --strict --explain --external-tokens LexToken))
+  (flags -la 1 --table --strict --explain
+         --external-tokens Lexer_cameligo.LexToken))
 
 ;; Build of the parser as a library
 
@@ -15,50 +50,47 @@
   (name parser_cameligo)
   (public_name ligo.parser.cameligo)
   (modules
-     Scoping cameligo Parser LexToken ParErr Pretty)
+    Scoping Parser ParErr Pretty)
   (libraries
-     pprint
+    ;; Ligo
-     terminal_size
+    lexer_cameligo
-     menhirLib
+    parser_shared
-     parser_shared
+    cst
-     str
+    ;; Vendors
-     simple-utils
+    simple-utils
-     tezos-utils
+    ;; Third party
-     cst
+    pprint
-  )
+    terminal_size
+    menhirLib
+    hex)
   (preprocess
     (pps bisect_ppx --conditional))
-  (flags (:standard -open Parser_shared -open Simple_utils)))
+  (flags (:standard -open Cst_cameligo))) ;; For CST in Parser.mli
 
-;; Build of the unlexer (for covering the error states of the LR
+;; Build of the unlexer (for covering the
-;; automaton)
+;; error states of the LR automaton)
 
 (executable
   (name Unlexer)
   (libraries str)
+  (modules Unlexer)
   (preprocess
-    (pps bisect_ppx --conditional))
+    (pps bisect_ppx --conditional)))
-  (modules Unlexer))
-
-;; Local build of a standalone lexer
-
-(executable
-  (name LexerMain)
-  (libraries parser_cameligo)
-  (modules LexerMain)
-  (preprocess
-    (pps bisect_ppx --conditional))
-  (flags (:standard -open Parser_shared -open Parser_cameligo)))
 
 ;; Local build of a standalone parser
 
 (executable
   (name ParserMain)
-  (libraries parser_cameligo)
+  (libraries
+    ;; Ligo
+    parser_shared
+    parser_cameligo
+    cst
+    ;; Third party
+    hex)
   (modules ParserMain Parser_msg)
   (preprocess
-    (pps bisect_ppx --conditional))
+    (pps bisect_ppx --conditional)))
-  (flags (:standard -open Simple_utils -open Parser_shared -open Parser_cameligo)))
 
 ;; Build of the covering of error states in the LR automaton
 
@@ -85,7 +117,14 @@
 (rule
   (targets all.mligo)
   (deps (:script_cover ../../../../vendors/ligo-utils/simple-utils/cover.sh) Parser.mly LexToken.mli ParToken.mly Parser.msg Unlexer.exe)
-  (action (run %{script_cover} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly --ext=mligo --unlexer=./Unlexer.exe --messages=Parser.msg --dir=. --concatenate Parser.mly )))
+  (action (run %{script_cover}
+               --lex-tokens=LexToken.mli
+               --par-tokens=ParToken.mly
+               --ext=mligo
+               --unlexer=./Unlexer.exe
+               --messages=Parser.msg
+               --dir=.
+               --concatenate Parser.mly)))
 
 ;; Error messages
 
@@ -95,60 +134,45 @@
  (deps Parser.mly ParToken.mly error.messages.checked-in LexToken.mli)
  (action
   (with-stdout-to %{targets}
-  (run
+  (run menhir
-    menhir
+       --unused-tokens
-      --unused-tokens
+       --update-errors error.messages.checked-in
-      --update-errors error.messages.checked-in
+       --table
-      --table
+       --strict
-      --strict
+       --external-tokens LexToken.mli
-      --external-tokens LexToken.mli
+       --base Parser.mly
-      --base Parser.mly
+       ParToken.mly
-      ParToken.mly
+       Parser.mly))))
-      Parser.mly
-    )
- ))
-)
 
 (rule
   (target error.messages.new)
   (mode (promote (until-clean) (only *)))
   (action
     (with-stdout-to %{target}
-      (run
+      (run menhir
-        menhir
+           --unused-tokens
-          --unused-tokens
+           --list-errors
-          --list-errors
+           --table
-          --table
+           --strict
-          --strict
+           --external-tokens LexToken.mli
-          --external-tokens LexToken.mli
+           --base Parser.mly
-          --base Parser.mly
+           ParToken.mly
-          ParToken.mly
+           Parser.mly))))
-          Parser.mly
-      )
-    )
-  )
-)
 
 (alias
   (name runtest)
   (deps error.messages error.messages.new)
   (action
-    (run
+    (run menhir
-      menhir
+         --unused-tokens
-        --unused-tokens
+         --table
-        --table
+         --strict
-        --strict
+         --external-tokens LexToken.mli
-        --external-tokens LexToken.mli
+         --base Parser.mly
-        --base Parser.mly
+         ParToken.mly
-        ParToken.mly
+         Parser.mly
-        Parser.mly
+         --compare-errors error.messages.new
-        --compare-errors error.messages.new
+         --compare-errors error.messages)))
-        --compare-errors error.messages
-      )
-    )
-  )
-
-
 
 (rule
  (targets ParErr.ml)
@@ -156,16 +180,12 @@
  (deps Parser.mly ParToken.mly error.messages.checked-in LexToken.mli)
  (action
   (with-stdout-to %{targets}
-  (run
+  (run menhir
-    menhir
+       --unused-tokens
-      --unused-tokens
+       --table
-      --table
+       --strict
-      --strict
+       --external-tokens LexToken.mli
-      --external-tokens LexToken.mli
+       --base Parser.mly
-      --base Parser.mly
+       ParToken.mly
-      ParToken.mly
+       Parser.mly
-      Parser.mly
+       --compile-errors error.messages.checked-in))))
-      --compile-errors error.messages.checked-in
-    )
- ))
-)

src/passes/01-parsing/parser.ml

@@ -2,4 +2,4 @@ module Pascaligo = Pascaligo
 module Cameligo = Cameligo
 module Reasonligo = Reasonligo
 module Errors = Errors
-module Formatter = Formatter
+module Formatter = Formatter

src/passes/01-parsing/pascaligo.ml

@@ -1,6 +1,9 @@
+(* Dependencies *)
+
+module EvalOpt  = Lexer_shared.EvalOpt
 module CST      = Cst.Pascaligo
-module LexToken = Parser_pascaligo.LexToken
+module LexToken = Lexer_pascaligo.LexToken
-module Lexer    = Lexer.Make(LexToken)
+module Lexer    = Lexer_shared.Lexer.Make (LexToken)
 module Scoping  = Parser_pascaligo.Scoping
 module Region   = Simple_utils.Region
 module ParErr   = Parser_pascaligo.ParErr

src/passes/01-parsing/pascaligo/.links

@@ -6,14 +6,10 @@ $HOME/git/OCaml-build/Makefile
 ../shared/LexerLib.ml
 ../shared/EvalOpt.ml
 ../shared/EvalOpt.mli
-../shared/FQueue.ml
-../shared/FQueue.mli
 ../shared/LexerLog.mli
 ../shared/LexerLog.ml
 ../shared/Markup.ml
 ../shared/Markup.mli
-../shared/Utils.mli
-../shared/Utils.ml
 ../shared/ParserAPI.mli
 ../shared/ParserAPI.ml
 ../shared/LexerUnit.mli
@@ -21,3 +17,14 @@ $HOME/git/OCaml-build/Makefile
 ../shared/ParserUnit.mli
 ../shared/ParserUnit.ml
 ../shared/LexerLib.ml
+
+./Stubs/Lexer_shared.ml
+./Stubs/Lexer_pascaligo.ml
+./Stubs/Parser_shared.ml
+./Stubs/Parser_pascaligo.ml
+./Stubs/Cst.ml
+./Stubs/Cst_pascaligo.ml
+
+$HOME/git/ligo/src/stages/1-cst/pascaligo/CST.ml
+$HOME/git/ligo/src/stages/1-cst/pascaligo/ParserLog.mli
+$HOME/git/ligo/src/stages/1-cst/pascaligo/ParserLog.ml

src/passes/01-parsing/pascaligo/LexToken.mli

@@ -21,13 +21,16 @@
    aliased to [token].
 *)
 
+(* Dependencies *)
+
 module Region = Simple_utils.Region
 module Pos    = Simple_utils.Pos
-
+module Markup = Lexer_shared.Markup
-type lexeme = string
 
 (* TOKENS *)
 
+type lexeme = string
+
 type attribute = {
   header : string;
   string : lexeme Region.reg

src/passes/01-parsing/pascaligo/LexToken.mll

@@ -1,21 +1,20 @@
-(* Lexer specification for LIGO, to be processed by [ocamllex] *)
+(* ocamlex specification for PascaLIGO *)
 
 {
 (* START HEADER *)
 
-(* Shorthands *)
+(* Dependencies *)
 
 module Region = Simple_utils.Region
 module Pos    = Simple_utils.Pos
+module Markup = Lexer_shared.Markup
 module SMap   = Map.Make (String)
 module SSet   = Set.Make (String)
 
-type lexeme = string
-
-let sprintf = Printf.sprintf
-
 (* TOKENS *)
 
+type lexeme = string
+
 type attribute = {
   header : string;
   string : lexeme Region.reg
@@ -117,6 +116,8 @@ type t =
 
 (* Projections *)
 
+let sprintf = Printf.sprintf
+
 type token = t
 
 let proj_token = function

src/passes/01-parsing/pascaligo/LexerMain.ml

@@ -1,6 +1,14 @@
 (* Driver for the PascaLIGO lexer *)
 
-module Region = Simple_utils.Region
+(* Dependencies *)
+
+module Region    = Simple_utils.Region
+module EvalOpt   = Lexer_shared.EvalOpt
+module Lexer     = Lexer_shared.Lexer
+module LexerUnit = Lexer_shared.LexerUnit
+module LexToken  = Lexer_pascaligo.LexToken
+
+(* Input/Output *)
 
 module IO =
   struct
@@ -10,8 +18,12 @@ module IO =
       in read ~block ~line:"//" ".ligo"
   end
 
+(* Instantiating the standalone lexer *)
+
 module M = LexerUnit.Make (IO) (Lexer.Make (LexToken))
 
+(* Tracing all tokens in the source *)
+
 let () =
   match M.trace () with
     Stdlib.Ok () -> ()

src/passes/01-parsing/pascaligo/ParToken.mly

@@ -1,4 +1,5 @@
 %{
+module LexToken = Lexer_pascaligo.LexToken
 %}
 
 (* Tokens (mirroring thise defined in module LexToken) *)

src/passes/01-parsing/pascaligo/Parser.mly

@@ -1,10 +1,13 @@
+(* Menhir specification of the parsing of PascaLIGO *)
 %{
 (* START HEADER *)
 
 [@@@warning "-42"]
 
+(* Dependencies *)
+
 open Simple_utils.Region
-module CST      = Cst.Pascaligo
+module CST = Cst.Pascaligo
 open CST
 
 (* END HEADER *)
@@ -15,8 +18,8 @@ open CST
 (* Entry points *)
 
 %start contract interactive_expr
-%type <Cst.Pascaligo.t> contract
+%type <CST.t> contract
-%type <Cst.Pascaligo.expr> interactive_expr
+%type <CST.expr> interactive_expr
 
 %%
 
@@ -143,7 +146,9 @@ type_decl:
                   terminator = $5}
     in {region; value} }
 
-type_expr_colon: ":" type_expr { $1,$2 }
+type_annot:
+  ":" type_expr { $1,$2 }
+
 type_expr:
   fun_type | sum_type | record_type { $1 }
 
@@ -241,7 +246,7 @@ field_decl:
 
 
 fun_expr:
-  "function" parameters type_expr_colon? "is" expr {
+  "function" parameters type_annot? "is" expr {
     let stop   = expr_to_region $5 in
     let region = cover $1 stop
     and value  = {kwd_function = $1;
@@ -254,8 +259,7 @@ fun_expr:
 (* Function declarations *)
 
 open_fun_decl:
-  ioption ("recursive") "function" fun_name parameters type_expr_colon? "is"
+  ioption("recursive") "function" fun_name parameters type_annot? "is" expr {
-  expr {
     Scoping.check_reserved_name $3;
     let stop   = expr_to_region $7 in
     let region = cover $2 stop
@@ -356,7 +360,7 @@ open_var_decl:
     in {region; value} }
 
 unqualified_decl(OP):
-  var type_expr_colon? OP expr {
+  var type_annot? OP expr {
     Scoping.check_reserved_name $1;
     let region = expr_to_region $4
     in $1, $2, $3, $4, region }
@@ -594,28 +598,17 @@ while_loop:
     in While {region; value} }
 
 for_loop:
-  "for" var ":=" expr "to" expr block {
+  "for" var ":=" expr "to" expr step_clause? block {
-    let region = cover $1 $7.region in
+    Scoping.check_reserved_name $2;
-    let value  = {kwd_for  = $1;
+    let region = cover $1 $8.region in
-                  binder   = $2;
+    let value  = {kwd_for = $1;
-                  assign   = $3;
+                  binder  = $2;
-                  init     = $4;
+                  assign  = $3;
-                  kwd_to   = $5;
+                  init    = $4;
-                  bound    = $6;
+                  kwd_to  = $5;
-                  step     = None;
+                  bound   = $6;
-                  block    = $7}
+                  step    = $7;
-    in For (ForInt {region; value})
+                  block   = $8}
-  }
-| "for" var ":=" expr "to" expr "step" expr block {
-    let region = cover $1 $9.region in
-    let value  = {kwd_for  = $1;
-                  binder   = $2;
-                  assign   = $3;
-                  init     = $4;
-                  kwd_to   = $5;
-                  bound    = $6;
-                  step     = Some ($7, $8);
-                  block    = $9}
     in For (ForInt {region; value})
   }
 | "for" var arrow_clause? "in" collection expr block {
@@ -630,6 +623,9 @@ for_loop:
                   block      = $7}
     in For (ForCollect {region; value}) }
 
+step_clause:
+  "step" expr { $1,$2 }
+
 collection:
   "map"  { Map  $1 }
 | "set"  { Set  $1 }
@@ -650,18 +646,13 @@ expr:
 | fun_expr   { EFun $1                   }
 | block_with { EBlock $1                 }
 
-block_with :
+block_with:
   block "with" expr {
-    let start = $2
+    let start  = $2
-    and stop  = expr_to_region $3 in
+    and stop   = expr_to_region $3 in
     let region = cover start stop in
-    let value : CST.block_with = {
+    let value  = {block=$1; kwd_with=$2; expr=$3}
-      block    = $1;
+    in {region; value} }
-      kwd_with = $2;
-      expr     = $3;
-    }
-    in {value;region}
-  }
 
 cond_expr:
   "if" expr "then" expr ";"? "else" expr {

src/passes/01-parsing/pascaligo/ParserMain.ml

@@ -1,7 +1,16 @@
 (* Driver for the PascaLIGO parser *)
 
-module Region = Simple_utils.Region
+(* Dependencies *)
-module SSet   = Set.Make (String)
+
+module Region     = Simple_utils.Region
+module EvalOpt    = Lexer_shared.EvalOpt
+module LexToken   = Lexer_pascaligo.LexToken
+module CST        = Cst.Pascaligo
+module SSet       = Set.Make (String)
+module ParserUnit = Parser_shared.ParserUnit
+module Pretty     = Parser_pascaligo.Pretty
+
+(* Input/Output *)
 
 module IO =
   struct
@@ -55,22 +64,22 @@ module SubIO =
 
 module Parser =
   struct
-    type ast  = AST.t
+    type ast  = CST.t
-    type expr = AST.expr
+    type expr = CST.expr
-    include Parser
+    include Parser_pascaligo.Parser
   end
 
 module ParserLog =
   struct
-    type ast  = AST.t
+    type ast  = CST.t
-    type expr = AST.expr
+    type expr = CST.expr
-    include ParserLog
+    include Cst_pascaligo.ParserLog
   end
 
-module Lexer = Lexer.Make (LexToken)
+module Lexer = Lexer_shared.Lexer.Make (LexToken)
 
 module Unit =
-  ParserUnit.Make (Lexer)(AST)(Parser)(Parser_msg)(ParserLog)(SubIO)
+  ParserUnit.Make (Lexer)(CST)(Parser)(Parser_msg)(ParserLog)(SubIO)
 
 (* Main *)
 

src/passes/01-parsing/pascaligo/Pretty.ml

@@ -40,12 +40,16 @@ and pp_attr_decl decl = pp_ne_injection pp_string decl
 
 and pp_const_decl {value; _} =
   let {name; const_type; init; attributes; _} = value in
+  let attr  = match attributes with
+                None -> empty
+              | Some a -> hardline ^^ pp_attr_decl a in
   let start = string ("const " ^ name.value) in
-  let t_expr = const_type in
+  let start =
-  let attr   = match attributes with
+    match const_type with
-                 None -> empty
+      None -> start
-               | Some a -> hardline ^^ pp_attr_decl a in
+    | Some (_, e) ->
-  group (start ^/^ pp_option (fun (_, d) -> nest 2 (string ": " ^^ pp_type_expr d)) t_expr)
+        group (start ^/^ nest 2 (string ": " ^^ pp_type_expr e)) in
+  start
   ^^ group (break 1 ^^ nest 2 (string "= " ^^ pp_expr init))
   ^^ attr
 
@@ -127,34 +131,46 @@ and pp_type_tuple {value; _} =
 
 and pp_fun_expr {value; _} =
   let {param; ret_type; return; _} : fun_expr = value in
-  let start = string "function" in
+  let start      = string "function" in
   let parameters = pp_par pp_parameters param in
-  let expr = pp_expr return in
+  let t_annot    =
+    match ret_type with
+      None -> empty
+    | Some (_, e) ->
+        group (break 1 ^^ nest 2 (string ": " ^^ pp_type_expr e)) in
   group (start ^^ nest 2 (break 1 ^^ parameters))
-  ^^ pp_option (fun (_,d) -> group (break 1 ^^ nest 2 (string ": " ^^ pp_type_expr d))) ret_type
+  ^^ t_annot
-  ^^ string " is" ^^ group (nest 4 (break 1 ^^ expr))
+  ^^ string " is" ^^ group (nest 4 (break 1 ^^ pp_expr return))
 
 and pp_fun_decl {value; _} =
-  let {kwd_recursive; fun_name; param;
+  let {kwd_recursive; fun_name; param; ret_type;
-       ret_type; return; attributes; _} = value in
+       return; attributes; _} = value in
   let start =
     match kwd_recursive with
         None -> string "function"
     | Some _ -> string "recursive" ^/^ string "function" in
-  let start = start ^^ group (break 1 ^^ nest 2 (pp_ident fun_name)) in
+  let start = start ^^ group (break 1 ^^ nest 2 (pp_ident fun_name))
-  let parameters = pp_par pp_parameters param in
+  and parameters = pp_par pp_parameters param
-  let expr = pp_expr return in
+  and t_annot_is =
-  let body =
+    match ret_type with
+      None -> string " is"
+    | Some (_, e) ->
+        let ret_type = pp_type_expr e in
+        group (nest 2 (break 1 ^^ string ": " ^^ nest 2 ret_type
+                       ^^ string " is"))
+  and body =
+    let expr = pp_expr return in
     match return with
       EBlock _ -> group (break 1 ^^ expr)
     | _ -> group (nest 2 (break 1 ^^ expr))
   and attr =
     match attributes with
-        None -> empty
+      None -> empty
     | Some a -> hardline ^^ pp_attr_decl a in
   prefix 2 1 start parameters
-  ^^ group (nest 2 (pp_option (fun (_, d) -> break 1 ^^ string ": " ^^ nest 2 (pp_type_expr d)) ret_type ^^ string " is"))
+  ^^ t_annot_is
-  ^^ body ^^ attr
+  ^^ body
+  ^^ attr
 
 and pp_parameters p = pp_nsepseq ";" pp_param_decl p
 
@@ -164,13 +180,19 @@ and pp_param_decl = function
 
 and pp_param_const {value; _} =
   let {var; param_type; _} : param_const = value in
-  let name   = string ("const " ^ var.value)
+  let name = string ("const " ^ var.value) in
-  in prefix 2 1 name @@ pp_option (fun (_,d) -> string ": " ^^ pp_type_expr d) param_type
+  match param_type with
+    None -> name
+  | Some (_, e) ->
+      prefix 2 1 (name ^^ string " :") (pp_type_expr e)
 
 and pp_param_var {value; _} =
   let {var; param_type; _} : param_var = value in
-  let name   = string ("var " ^ var.value)
+  let name   = string ("var " ^ var.value) in
-  in prefix 2 1 name @@ pp_option (fun (_,d) -> string ": " ^^ pp_type_expr d) param_type
+  match param_type with
+    None -> name
+  | Some (_, e) ->
+      prefix 2 1 (name ^^ string " :") (pp_type_expr e)
 
 and pp_block {value; _} =
   string "block {"
@@ -192,7 +214,12 @@ and pp_data_decl = function
 and pp_var_decl {value; _} =
   let {name; var_type; init; _} = value in
   let start = string ("var " ^ name.value) in
-  group (start ^/^ pp_option (fun (_,d) -> nest 2 (string ": " ^^ pp_type_expr d)) var_type)
+  let start =
+    match var_type with
+      None -> start
+    | Some (_, e) ->
+        group (start ^/^ nest 2 (string ": " ^^ pp_type_expr e)) in
+  start
   ^^ group (break 1 ^^ nest 2 (string ":= " ^^ pp_expr init))
 
 and pp_instruction = function
@@ -381,11 +408,11 @@ and pp_expr = function
 | EBlock      e -> pp_block_with e
 
 and pp_block_with {value; _} =
-  let {block;kwd_with; expr;_} = value in
+  let {block; kwd_with; expr} = value in
   let expr = value.expr in
   let expr = pp_expr expr in
-  group(pp_block block ^^ string " with"
+  group (pp_block block ^^ string " with"
-    ^^ group (nest 4 (break 1 ^^ expr)))
+         ^^ group (nest 4 (break 1 ^^ expr)))
 
 and pp_annot_expr {value; _} =
   let expr, _, type_expr = value.inside in

src/passes/01-parsing/pascaligo/Scoping.ml

@@ -1,7 +1,13 @@
+(* This module exports checks on scoping, called from the parser. *)
+
 [@@@warning "-42"]
 
+(* Dependencies *)
+
 module Region = Simple_utils.Region
-module CST      = Cst.Pascaligo
+module CST    = Cst.Pascaligo
+
+(* Errors *)
 
 type t =
   Reserved_name       of CST.variable
@@ -18,7 +24,7 @@ open Region
 
 (* Useful modules *)
 
-module SSet = Utils.String.Set
+module SSet = Set.Make (String)
 
 module Ord =
   struct

src/passes/01-parsing/pascaligo/Scoping.mli

@@ -1,7 +1,11 @@
 (* This module exports checks on scoping, called from the parser. *)
 
+(* Dependencies *)
+
 module Region = Simple_utils.Region
-module CST      = Cst.Pascaligo
+module CST    = Cst.Pascaligo
+
+(* Errors *)
 
 type t =
   Reserved_name       of CST.variable

src/passes/01-parsing/pascaligo/Stubs/Cst.ml

@@ -0,0 +1 @@
+module Pascaligo = CST

src/passes/01-parsing/pascaligo/Stubs/Cst_pascaligo.ml

@@ -0,0 +1 @@
+module ParserLog = ParserLog

src/passes/01-parsing/pascaligo/Stubs/Lexer_pascaligo.ml

@@ -0,0 +1 @@
+module LexToken = LexToken

src/passes/01-parsing/pascaligo/Stubs/Lexer_shared.ml

@@ -0,0 +1,6 @@
+module EvalOpt   = EvalOpt
+module Markup    = Markup
+module Lexer     = Lexer
+module LexerUnit = LexerUnit
+module LexerLog  = LexerLog
+module LexerLib  = LexerLib

src/passes/01-parsing/pascaligo/Stubs/Parser_pascaligo.ml

@@ -0,0 +1,2 @@
+module Pretty = Pretty
+module Parser = Parser

src/passes/01-parsing/pascaligo/Stubs/Parser_shared.ml

@@ -0,0 +1 @@
+module ParserUnit = ParserUnit

src/passes/01-parsing/pascaligo/dune

@@ -1,13 +1,48 @@
+;; --------------------------------------------------------------------
+;; LEXING
+
 ;; Build of the lexer
 
 (ocamllex LexToken)
 
+;; Build of the lexer as a library
+
+(library
+  (name lexer_pascaligo)
+  (public_name ligo.lexer.pascaligo)
+  (modules LexToken)
+  (libraries
+    ;; Ligo
+    lexer_shared
+    ;; Third party
+    hex)
+  (preprocess
+    (pps bisect_ppx --conditional)))
+
+;; Build of a standalone lexer
+
+(executable
+  (name LexerMain)
+  (libraries
+    ;; Ligo
+    lexer_shared
+    lexer_pascaligo
+    ;; Third party
+    hex)
+  (modules LexerMain)
+  (preprocess
+    (pps bisect_ppx --conditional)))
+
+;; --------------------------------------------------------------------
+;; PARSING
+
 ;; Build of the parser
 
 (menhir
   (merge_into Parser)
   (modules ParToken Parser)
-  (flags -la 1 --table --strict --explain --external-tokens LexToken))
+  (flags -la 1 --table --strict --explain
+         --external-tokens Lexer_pascaligo.LexToken))
 
 ;; Build of the parser as a library
 
@@ -15,19 +50,22 @@
   (name parser_pascaligo)
   (public_name ligo.parser.pascaligo)
   (modules
-     Scoping pascaligo Parser LexToken ParErr Pretty)
+    Scoping Parser ParErr Pretty)
   (libraries
-     pprint
+    ;; Ligo
-     terminal_size
+    lexer_pascaligo
-     menhirLib
+    parser_shared
-     parser_shared
+    cst
-     hex
+    ;; Vendors
-     Preprocessor
+    simple-utils
-     simple-utils
+    ;; Third party
-     cst)
+    pprint
+    terminal_size
+    menhirLib
+    hex)
   (preprocess
     (pps bisect_ppx --conditional))
-  (flags (:standard -open Parser_shared -open Simple_utils)))
+  (flags (:standard -open Cst_pascaligo))) ;; For CST in Parser.mli
 
 ;; Build of the unlexer (for covering the
 ;; error states of the LR automaton)
@@ -35,30 +73,24 @@
 (executable
   (name Unlexer)
   (libraries str)
+  (modules Unlexer)
   (preprocess
-    (pps bisect_ppx --conditional))
+    (pps bisect_ppx --conditional)))
-  (modules Unlexer))
-
-;; Local build of a standalone lexer
-
-(executable
-  (name LexerMain)
-  (libraries
-     hex simple-utils tezos-utils parser_pascaligo)
-  (modules LexerMain)
-  (preprocess
-    (pps bisect_ppx --conditional))
-  (flags (:standard -open Parser_shared -open Parser_pascaligo)))
 
 ;; Local build of a standalone parser
 
 (executable
   (name ParserMain)
-  (libraries parser_pascaligo)
+  (libraries
-  (modules ParserMain)
+    ;; Ligo
+    parser_shared
+    parser_pascaligo
+    cst
+    ;; Third party
+    hex)
+  (modules ParserMain Parser_msg)
   (preprocess
-    (pps bisect_ppx --conditional))
+    (pps bisect_ppx --conditional)))
-  (flags (:standard -open Simple_utils -open Parser_shared -open Parser_pascaligo)))
 
 ;; Build of the covering of error states in the LR automaton
 
@@ -85,7 +117,14 @@
 (rule
   (targets all.ligo)
   (deps (:script_cover ../../../../vendors/ligo-utils/simple-utils/cover.sh) Parser.mly LexToken.mli ParToken.mly Parser.msg Unlexer.exe)
-  (action (run %{script_cover} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly --ext=ligo --unlexer=./Unlexer.exe --messages=Parser.msg --dir=. --concatenate Parser.mly)))
+  (action (run %{script_cover}
+               --lex-tokens=LexToken.mli
+               --par-tokens=ParToken.mly
+               --ext=ligo
+               --unlexer=./Unlexer.exe
+               --messages=Parser.msg
+               --dir=.
+               --concatenate Parser.mly)))
 
 ;; Error messages
 
@@ -95,58 +134,45 @@
  (deps Parser.mly ParToken.mly error.messages.checked-in LexToken.mli)
  (action
   (with-stdout-to %{targets}
-  (run
+  (run menhir
-    menhir
+       --unused-tokens
-      --unused-tokens
+       --update-errors error.messages.checked-in
-      --update-errors error.messages.checked-in
+       --table
-      --table
+       --strict
-      --strict
+       --external-tokens LexToken.mli
-      --external-tokens LexToken.mli
+       --base Parser.mly
-      --base Parser.mly
+       ParToken.mly
-      ParToken.mly
+       Parser.mly))))
-      Parser.mly
-    )
- ))
-)
 
 (rule
   (target error.messages.new)
   (mode (promote (until-clean) (only *)))
   (action
     (with-stdout-to %{target}
-      (run
+      (run menhir
-        menhir
+           --unused-tokens
-          --unused-tokens
+           --list-errors
-          --list-errors
+           --table
-          --table
+           --strict
-          --strict
+           --external-tokens LexToken.mli
-          --external-tokens LexToken.mli
+           --base Parser.mly
-          --base Parser.mly
+           ParToken.mly
-          ParToken.mly
+           Parser.mly))))
-          Parser.mly
-      )
-    )
-  )
-)
 
 (alias
   (name runtest)
   (deps error.messages error.messages.new)
   (action
-    (run
+    (run menhir
-      menhir
+         --unused-tokens
-        --unused-tokens
+         --table
-        --table
+         --strict
-        --strict
+         --external-tokens LexToken.mli
-        --external-tokens LexToken.mli
+         --base Parser.mly
-        --base Parser.mly
+         ParToken.mly
-        ParToken.mly
+         Parser.mly
-        Parser.mly
+         --compare-errors error.messages.new
-        --compare-errors error.messages.new
+         --compare-errors error.messages)))
-        --compare-errors error.messages
-      )
-    )
-  )
 
 (rule
  (targets ParErr.ml)
@@ -154,16 +180,12 @@
  (deps Parser.mly ParToken.mly error.messages.checked-in LexToken.mli)
  (action
   (with-stdout-to %{targets}
-  (run
+  (run menhir
-    menhir
+       --unused-tokens
-      --unused-tokens
+       --table
-      --table
+       --strict
-      --strict
+       --external-tokens LexToken.mli
-      --external-tokens LexToken.mli
+       --base Parser.mly
-      --base Parser.mly
+       ParToken.mly
-      ParToken.mly
+       Parser.mly
-      Parser.mly
+       --compile-errors error.messages.checked-in))))
-      --compile-errors error.messages.checked-in
-    )
- ))
-)

src/passes/01-parsing/pascaligo/pascaligo.ml

@@ -1,3 +0,0 @@
-module Lexer     = Lexer
-module LexToken  = LexToken
-module Parser    = Parser

src/passes/01-parsing/reasonligo.ml

@@ -1,12 +1,13 @@
 module CST         = Cst.Cameligo
-module LexToken    = Parser_reasonligo.LexToken
+module LexToken    = Lexer_reasonligo.LexToken
-module Lexer       = Lexer.Make (LexToken)
+module Lexer       = Lexer_shared.Lexer.Make (LexToken)
 module Scoping     = Parser_cameligo.Scoping
 module Region      = Simple_utils.Region
 module ParErr      = Parser_reasonligo.ParErr
 module SyntaxError = Parser_reasonligo.SyntaxError
 module SSet        = Set.Make (String)
 module Pretty      = Parser_reasonligo.Pretty
+module EvalOpt     = Lexer_shared.EvalOpt
 
 (* Mock IOs TODO: Fill them with CLI options *)
 

src/passes/01-parsing/reasonligo/.links

@@ -5,14 +5,10 @@ $HOME/git/OCaml-build/Makefile
 ../shared/LexerLib.ml
 ../shared/EvalOpt.ml
 ../shared/EvalOpt.mli
-../shared/FQueue.ml
-../shared/FQueue.mli
 ../shared/LexerLog.mli
 ../shared/LexerLog.ml
 ../shared/Markup.ml
 ../shared/Markup.mli
-../shared/Utils.mli
-../shared/Utils.ml
 ../shared/ParserAPI.mli
 ../shared/ParserAPI.ml
 ../shared/LexerUnit.mli
@@ -20,10 +16,13 @@ $HOME/git/OCaml-build/Makefile
 ../shared/ParserUnit.mli
 ../shared/ParserUnit.ml
 
-Stubs/Parser_cameligo.ml
+./Stubs/Lexer_shared.ml
+./Stubs/Lexer_reasonligo.ml
+./Stubs/Parser_shared.ml
+./Stubs/Parser_reasonligo.ml
+./Stubs/Cst.ml
+./Stubs/Cst_cameligo.ml
 
-../cameligo/AST.ml
+$HOME/git/ligo/src/stages/1-cst/cameligo/CST.ml
-../cameligo/ParserLog.mli
+$HOME/git/ligo/src/stages/1-cst/cameligo/ParserLog.mli
-../cameligo/ParserLog.ml
+$HOME/git/ligo/src/stages/1-cst/cameligo/ParserLog.ml
-../cameligo/Scoping.mli
-../cameligo/Scoping.ml

src/passes/01-parsing/reasonligo/LexToken.mli

@@ -21,13 +21,16 @@
    aliased to [token].
 *)
 
+(* Dependencies *)
+
 module Region = Simple_utils.Region
 module Pos    = Simple_utils.Pos
-
+module Markup = Lexer_shared.Markup
-type lexeme = string
 
 (* TOKENS *)
 
+type lexeme = string
+
 type t =
   (* Identifiers, labels, numbers and strings *)
 

src/passes/01-parsing/reasonligo/LexToken.mll

@@ -1,19 +1,19 @@
+(* ocamlex specification for ReasonLIGO *)
 {
 (* START OF HEADER *)
 
-(* Shorthands *)
+(* Dependencies *)
 
 module Region = Simple_utils.Region
 module Pos    = Simple_utils.Pos
-module SMap   = Utils.String.Map
+module Markup = Lexer_shared.Markup
-module SSet   = Utils.String.Set
+module SMap   = Map.Make (String)
-
+module SSet   = Set.Make (String)
-type lexeme = string
-
-let sprintf = Printf.sprintf
 
 (* TOKENS *)
 
+type lexeme = string
+
 type t =
   (* Identifiers, labels, numbers and strings *)
 
@@ -103,6 +103,8 @@ type t =
 
 (* Projections *)
 
+let sprintf = Printf.sprintf
+
 type token = t
 
 let proj_token = function

src/passes/01-parsing/reasonligo/LexerMain.ml

@@ -1,6 +1,14 @@
 (* Driver for the ReasonLIGO lexer *)
 
-module Region = Simple_utils.Region
+(* Dependencies *)
+
+module Region    = Simple_utils.Region
+module EvalOpt   = Lexer_shared.EvalOpt
+module Lexer     = Lexer_shared.Lexer
+module LexerUnit = Lexer_shared.LexerUnit
+module LexToken  = Lexer_reasonligo.LexToken
+
+(* Input/Output *)
 
 module IO =
   struct

src/passes/01-parsing/reasonligo/ParToken.mly

@@ -1,4 +1,5 @@
 %{
+module LexToken = Lexer_reasonligo.LexToken
 %}
 
 (* Tokens (mirroring those defined in module LexToken) *)

src/passes/01-parsing/reasonligo/ParserMain.ml

@@ -1,7 +1,16 @@
 (* Driver for the ReasonLIGO parser *)
 
-module Region = Simple_utils.Region
+(* Dependencies *)
-module SSet   = Set.Make (String)
+
+module Region     = Simple_utils.Region
+module EvalOpt    = Lexer_shared.EvalOpt
+module LexToken   = Lexer_reasonligo.LexToken
+module CST        = Cst.Cameligo
+module SSet       = Set.Make (String)
+module ParserUnit = Parser_shared.ParserUnit
+module Pretty     = Parser_reasonligo.Pretty
+
+(* Input/Output *)
 
 module IO =
   struct
@@ -55,22 +64,22 @@ module SubIO =
 
 module Parser =
   struct
-    type ast  = AST.t
+    type ast  = CST.t
-    type expr = AST.expr
+    type expr = CST.expr
-    include Parser
+    include Parser_reasonligo.Parser
   end
 
 module ParserLog =
   struct
-    type ast  = AST.t
+    type ast  = CST.t
-    type expr = AST.expr
+    type expr = CST.expr
-    include ParserLog
+    include Cst_cameligo.ParserLog
   end
 
-module Lexer = Lexer.Make (LexToken)
+module Lexer = Lexer_shared.Lexer.Make (LexToken)
 
 module Unit =
-  ParserUnit.Make (Lexer)(AST)(Parser)(Parser_msg)(ParserLog)(SubIO)
+  ParserUnit.Make (Lexer)(CST)(Parser)(Parser_msg)(ParserLog)(SubIO)
 
 (* Main *)
 

src/passes/01-parsing/reasonligo/Pretty.ml

@@ -5,6 +5,7 @@ open CST
 module Region = Simple_utils.Region
 open! Region
 open! PPrint
+module Option = Simple_utils.Option
 
 let rec print ast =
   let app decl = group (pp_declaration decl) in

src/passes/01-parsing/reasonligo/Scoping.ml

@@ -0,0 +1 @@
+../cameligo/Scoping.ml

src/passes/01-parsing/reasonligo/Scoping.mli

@@ -0,0 +1 @@
+../cameligo/Scoping.mli

src/passes/01-parsing/reasonligo/Stubs/Cst.ml

@@ -0,0 +1 @@
+module Cameligo = CST

src/passes/01-parsing/reasonligo/Stubs/Cst_cameligo.ml

@@ -0,0 +1 @@
+module ParserLog = ParserLog

src/passes/01-parsing/reasonligo/Stubs/Lexer_reasonligo.ml

@@ -0,0 +1 @@
+module LexToken = LexToken

src/passes/01-parsing/reasonligo/Stubs/Lexer_shared.ml

@@ -0,0 +1,6 @@
+module EvalOpt   = EvalOpt
+module Markup    = Markup
+module Lexer     = Lexer
+module LexerUnit = LexerUnit
+module LexerLog  = LexerLog
+module LexerLib  = LexerLib

src/passes/01-parsing/reasonligo/Stubs/Parser_cameligo.ml

@@ -1 +0,0 @@
-module AST = AST

src/passes/01-parsing/reasonligo/Stubs/Parser_reasonligo.ml

@@ -0,0 +1,2 @@
+module Pretty = Pretty
+module Parser = Parser

src/passes/01-parsing/reasonligo/Stubs/Parser_shared.ml

@@ -0,0 +1 @@
+module ParserUnit = ParserUnit

src/passes/01-parsing/reasonligo/SyntaxError.ml

@@ -1,6 +1,6 @@
 module CST = Cst.Cameligo
 
-type error = 
+type error =
   | WrongFunctionArguments of CST.expr
   | InvalidWild of CST.expr
 

src/passes/01-parsing/reasonligo/dune

@@ -1,30 +1,71 @@
+;; --------------------------------------------------------------------
+;; LEXING
+
 ;; Build of the lexer
 
 (ocamllex LexToken)
 
+;; Build of the lexer as a library
+
+(library
+  (name lexer_reasonligo)
+  (public_name ligo.lexer.reasonligo)
+  (modules LexToken)
+  (libraries
+    ;; Ligo
+    lexer_shared
+    ;; Third party
+    hex)
+  (preprocess
+    (pps bisect_ppx --conditional)))
+
+;; Build of a standalone lexer
+
+(executable
+  (name LexerMain)
+  (libraries
+    ;; Ligo
+    lexer_shared
+    lexer_reasonligo
+    ;; Third party
+    hex)
+  (modules LexerMain)
+  (preprocess
+    (pps bisect_ppx --conditional)))
+
+;; --------------------------------------------------------------------
+;; PARSING
+
 ;; Build of the parser
 
 (menhir
   (merge_into Parser)
   (modules ParToken Parser)
-  (flags -la 1 --table --strict --explain --external-tokens LexToken))
+  (flags -la 1 --table --strict --explain
+         --external-tokens Lexer_reasonligo.LexToken))
 
 ;; Build of the parser as a library
 
 (library
- (name parser_reasonligo)
+  (name parser_reasonligo)
- (public_name ligo.parser.reasonligo)
+  (public_name ligo.parser.reasonligo)
- (modules
+  (modules
-    SyntaxError reasonligo LexToken ParErr Parser Pretty)
+    SyntaxError Scoping Parser ParErr Pretty)
- (libraries
+  (libraries
-    menhirLib
+    ;; Ligo
+    lexer_reasonligo
     parser_shared
-    parser_cameligo
+    cst
-    str
+    ;; Vendors
-    simple-utils)
+    simple-utils
- (preprocess
+    ;; Third party
-   (pps bisect_ppx --conditional))
+    pprint
- (flags (:standard -open Parser_shared -open Simple_utils -open Parser_cameligo)))
+    terminal_size
+    menhirLib
+    hex)
+  (preprocess
+    (pps bisect_ppx --conditional))
+  (flags (:standard -open Cst_cameligo))) ;; For CST in Parser.mli
 
 ;; Build of the unlexer (for covering the
 ;; error states of the LR automaton)
@@ -32,38 +73,31 @@
 (executable
   (name Unlexer)
   (libraries str)
+  (modules Unlexer)
   (preprocess
-    (pps bisect_ppx --conditional))
+    (pps bisect_ppx --conditional)))
-  (modules Unlexer))
-
-;; Local build of a standalone lexer
-
-(executable
-  (name LexerMain)
-  (libraries parser_reasonligo)
-  (modules LexerMain)
-  (preprocess
-    (pps bisect_ppx --conditional))
-  (flags (:standard -open Parser_shared -open Parser_reasonligo)))
 
 ;; Local build of a standalone parser
 
 (executable
   (name ParserMain)
   (libraries
-     parser_reasonligo
+    ;; Ligo
-     parser_cameligo)
+    parser_shared
-  (modules ParserMain)
+    parser_reasonligo
+    cst
+    ;; Third party
+    hex)
+  (modules ParserMain Parser_msg)
   (preprocess
-    (pps bisect_ppx --conditional))
+    (pps bisect_ppx --conditional)))
-  (flags (:standard -open Simple_utils -open Parser_cameligo -open Parser_shared -open Parser_reasonligo)))
 
 ;; Build of the covering of error states in the LR automaton
 
 (rule
   (targets Parser.msg)
   (deps (:script_messages ../../../../vendors/ligo-utils/simple-utils/messages.sh) Parser.mly LexToken.mli ParToken.mly)
-  (action (run %{script_messages} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly Parser.mly )))
+  (action (run %{script_messages} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly Parser.mly)))
 
 (rule
  (targets Parser_msg.ml)
@@ -83,7 +117,16 @@
 (rule
   (targets all.religo)
   (deps (:script_cover ../../../../vendors/ligo-utils/simple-utils/cover.sh) Parser.mly LexToken.mli ParToken.mly Parser.msg Unlexer.exe)
-  (action (run %{script_cover} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly --ext=religo --unlexer=./Unlexer.exe --messages=Parser.msg --dir=. --concatenate Parser.mly )))
+  (action (run %{script_cover}
+               --lex-tokens=LexToken.mli
+               --par-tokens=ParToken.mly
+               --ext=religo
+               --unlexer=./Unlexer.exe
+               --messages=Parser.msg
+               --dir=.
+               --concatenate Parser.mly)))
+
+;; Error messages
 
 (rule
  (targets error.messages)
@@ -91,60 +134,45 @@
  (deps Parser.mly ParToken.mly error.messages.checked-in LexToken.mli)
  (action
   (with-stdout-to %{targets}
-  (run
+  (run menhir
-     menhir
+       --unused-tokens
-      --unused-tokens
+       --update-errors error.messages.checked-in
-      --update-errors error.messages.checked-in
+       --table
-      --table
+       --strict
-      --strict
+       --external-tokens LexToken.mli
-      --external-tokens LexToken.mli
+       --base Parser.mly
-      --base Parser.mly
+       ParToken.mly
-      ParToken.mly
+       Parser.mly))))
-      Parser.mly
-    )
- ))
-)
 
 (rule
   (target error.messages.new)
   (mode (promote (until-clean) (only *)))
   (action
     (with-stdout-to %{target}
-      (run
+      (run menhir
-        menhir
+           --unused-tokens
-          --unused-tokens
+           --list-errors
-          --list-errors
+           --table
-          --table
+           --strict
-          --strict
+           --external-tokens LexToken.mli
-          --external-tokens LexToken.mli
+           --base Parser.mly
-          --base Parser.mly
+           ParToken.mly
-          ParToken.mly
+           Parser.mly))))
-          Parser.mly
-      )
-    )
-  )
-)
 
 (alias
   (name runtest)
   (deps error.messages error.messages.new)
   (action
-    (run
+    (run menhir
-      menhir
+         --unused-tokens
-        --unused-tokens
+         --table
-        --table
+         --strict
-        --strict
+         --external-tokens LexToken.mli
-        --external-tokens LexToken.mli
+         --base Parser.mly
-        --base Parser.mly
+         ParToken.mly
-        ParToken.mly
+         Parser.mly
-        Parser.mly
+         --compare-errors error.messages.new
-        --compare-errors error.messages.new
+         --compare-errors error.messages)))
-        --compare-errors error.messages
-      )
-    )
-  )
-
-
 
 (rule
  (targets ParErr.ml)
@@ -152,16 +180,12 @@
  (deps Parser.mly ParToken.mly error.messages.checked-in LexToken.mli)
  (action
   (with-stdout-to %{targets}
-  (run
+  (run menhir
-    menhir
+       --unused-tokens
-      --unused-tokens
+       --table
-      --table
+       --strict
-      --strict
+       --external-tokens LexToken.mli
-      --external-tokens LexToken.mli
+       --base Parser.mly
-      --base Parser.mly
+       ParToken.mly
-      ParToken.mly
+       Parser.mly
-      Parser.mly
+       --compile-errors error.messages.checked-in))))
-      --compile-errors error.messages.checked-in
-    )
- ))
-)

src/passes/01-parsing/reasonligo/reasonligo.ml

@@ -1,4 +0,0 @@
-module Parser = Parser
-module Lexer = Lexer
-module LexToken = LexToken
-module SyntaxError = SyntaxError

src/passes/01-parsing/shared/Lexer.mll

@@ -438,13 +438,13 @@ and scan state = parse
 
 (* String *)
 
-| '"' { let opening, _, state = state#sync lexbuf in
+| '"'  { let opening, _, state = state#sync lexbuf in
-        let thread = LexerLib.mk_thread opening "" in
+         let thread = LexerLib.mk_thread opening in
-        scan_string thread state lexbuf |> mk_string }
+         scan_string thread state lexbuf |> mk_string }
 
 | "{|" { let opening, _, state = state#sync lexbuf in
-        let thread = LexerLib.mk_thread opening "" in
+         let thread = LexerLib.mk_thread opening in
-        scan_verbatim thread state lexbuf |> mk_verbatim }
+         scan_verbatim thread state lexbuf |> mk_verbatim }
 
 (* Comments *)
 
@@ -453,33 +453,28 @@ and scan state = parse
     match state#block with
       Some block when block#opening = lexeme ->
         let opening, _, state = state#sync lexbuf in
-        let thread            = LexerLib.mk_thread opening lexeme in
+        let thread            = LexerLib.mk_thread opening in
-        let thread, state     = scan_block block thread state lexbuf in
+        let thread            = thread#push_string lexeme in
-        let state             = state#push_block thread
+        let thread, state     = scan_block block thread state lexbuf
-        in scan state lexbuf
+        in scan (state#push_block thread) lexbuf
-    | Some _ | None ->
+    | Some _ | None -> (* Not a comment for this LIGO syntax *)
-        let n = String.length lexeme in
+        let n  = String.length lexeme in
-          begin
+        let () = LexerLib.rollback lexbuf in
-            LexerLib.rollback lexbuf;
+        scan (scan_n_sym n state lexbuf) lexbuf }
-            assert (n > 0);
-            scan (scan_n_sym n state lexbuf) lexbuf
-          end }
 
 | line_comments {
     let lexeme = Lexing.lexeme lexbuf in
     match state#line with
       Some line when line = lexeme ->
         let opening, _, state = state#sync lexbuf in
-        let thread            = LexerLib.mk_thread opening lexeme in
+        let thread            = LexerLib.mk_thread opening in
-        let thread, state     = scan_line thread state lexbuf in
+        let thread            = thread#push_string lexeme in
-        let state             = state#push_line thread
+        let thread, state     = scan_line thread state lexbuf
-        in scan state lexbuf
+        in scan (state#push_line thread) lexbuf
-    | Some _ | None ->
+    | Some _ | None -> (* Not a comment for this LIGO syntax *)
-        let n = String.length lexeme in
+        let n  = String.length lexeme in
-          begin
+        let () = LexerLib.rollback lexbuf in
-            LexerLib.rollback lexbuf;
+        scan (scan_n_sym n state lexbuf) lexbuf }
-            scan (scan_n_sym n state lexbuf) lexbuf
-          end }
 
 | _ as c { let region, _, _ = state#sync lexbuf
            in fail region (Unexpected_character c) }
@@ -488,8 +483,7 @@ and scan state = parse
 
 and scan_n_sym n state = parse
   symbol { let state = mk_sym state lexbuf in
-           if n = 1 then state
+           if n = 1 then state else scan_n_sym (n-1) state lexbuf }
-           else scan_n_sym (n-1) state lexbuf }
 
 (* Scanning #include flag *)
 
@@ -552,7 +546,6 @@ and scan_block block thread state = parse
          in scan_block block thread state lexbuf
     else let ()    = LexerLib.rollback lexbuf in
          let n     = String.length lexeme in
-         let ()    = assert (n > 0) in
          let state = scan_n_sym n state lexbuf
          in scan_block block thread state lexbuf }
 
@@ -563,7 +556,6 @@ and scan_block block thread state = parse
          in thread#push_string lexeme, state
     else let ()    = LexerLib.rollback lexbuf in
          let n     = String.length lexeme in
-         let ()    = assert (n > 0) in
          let state = scan_n_sym n state lexbuf
          in scan_block block thread state lexbuf }
 
@@ -588,27 +580,6 @@ and scan_block block thread state = parse
             let region = Region.make ~start:state#pos ~stop:pos
             in fail region error }
 
-(* Finishing a line comment *)
-
-and scan_line thread state = parse
-  nl as nl { let     () = Lexing.new_line lexbuf
-             and thread = thread#push_string nl
-             and state  = state#set_pos (state#pos#new_line nl)
-             in thread, state }
-| eof      { thread, state }
-| _        { let     () = LexerLib.rollback lexbuf in
-             let len    = thread#length in
-             let thread,
-                 status = scan_utf8_inline thread state lexbuf in
-             let delta  = thread#length - len in
-             let pos    = state#pos#shift_one_uchar delta in
-             match status with
-               Stdlib.Ok () ->
-                 scan_line thread (state#set_pos pos) lexbuf
-             | Error error ->
-                 let region = Region.make ~start:state#pos ~stop:pos
-                 in fail region error }
-
 and scan_utf8 block thread state = parse
      eof { let err = Unterminated_comment block#closing
            in fail thread#opening err }
@@ -621,6 +592,27 @@ and scan_utf8 block thread state = parse
            | `Await       -> scan_utf8 block thread state lexbuf
            | `End         -> assert false }
 
+(* Finishing a line comment *)
+
+and scan_line thread state = parse
+  nl as nl { let ()     = Lexing.new_line lexbuf
+             and thread = thread#push_string nl
+             and state  = state#set_pos (state#pos#new_line nl)
+             in thread, state }
+| eof      { thread, state }
+| _        { let ()     = LexerLib.rollback lexbuf in
+             let len    = thread#length in
+             let thread,
+                 status = scan_utf8_inline thread state lexbuf in
+             let delta  = thread#length - len in
+             let pos    = state#pos#shift_one_uchar delta in
+             match status with
+               Stdlib.Ok () ->
+                 scan_line thread (state#set_pos pos) lexbuf
+             | Error error ->
+                 let region = Region.make ~start:state#pos ~stop:pos
+                 in fail region error }
+
 and scan_utf8_inline thread state = parse
      eof { thread, Stdlib.Ok () }
 | _ as c { let thread = thread#push_char c in

src/passes/01-parsing/shared/LexerLib.ml

@@ -1,5 +1,8 @@
+(* A library for writing UTF8-aware lexers *)
+
 module Region = Simple_utils.Region
-module Pos = Simple_utils.Pos
+module Pos    = Simple_utils.Pos
+module FQueue = Simple_utils.FQueue
 
 (* LEXER ENGINE *)
 
@@ -69,7 +72,7 @@ type thread = <
   set_opening : Region.t -> thread
 >
 
-let mk_thread region lexeme : thread =
+let mk_thread region : thread =
   (* The call [explode s a] is the list made by pushing the characters
      in the string [s] on top of [a], in reverse order. For example,
      [explode "ba" ['c';'d'] = ['a'; 'b'; 'c'; 'd']]. *)
@@ -83,10 +86,10 @@ let mk_thread region lexeme : thread =
     val opening = region
     method opening = opening
 
-    val length = String.length lexeme
+    val length = 0
     method length = length
 
-    val acc = explode lexeme []
+    val acc = []
     method acc = acc
 
     method set_opening opening = {< opening; length; acc >}
@@ -100,10 +103,10 @@ let mk_thread region lexeme : thread =
          acc = explode str acc >}
 
     (* The value of [thread#to_string] is a string of length
-       [thread#length] containing the [thread#length] characters in
+       [thread#length] containing the characters in the list
-       the list [thread#acc], in reverse order. For instance,
+       [thread#acc], in reverse order. For instance, [thread#to_string
-       [thread#to_string = "abc"] if [thread#length = 3] and
+       = "abc"] if [thread#length = 3] and [thread#acc =
-       [thread#acc = ['c';'b';'a']]. *)
+       ['c';'b';'a']]. *)
 
     method to_string =
       let bytes = Bytes.make length ' ' in
@@ -159,15 +162,16 @@ type 'token window =
 | Two of 'token * 'token
 
 type 'token state = <
-  units   : (Markup.t list * 'token) FQueue.t;
+  units    : (Markup.t list * 'token) FQueue.t;
-  markup  : Markup.t list;
+  markup   : Markup.t list;
-  window  : 'token window;
+  comments : Markup.comment FQueue.t;
-  last    : Region.t;
+  window   : 'token window;
-  pos     : Pos.t;
+  last     : Region.t;
-  decoder : Uutf.decoder;
+  pos      : Pos.t;
-  supply  : Bytes.t -> int -> int -> unit;
+  decoder  : Uutf.decoder;
-  block   : EvalOpt.block_comment option;
+  supply   : Bytes.t -> int -> int -> unit;
-  line    : EvalOpt.line_comment option;
+  block    : EvalOpt.block_comment option;
+  line     : EvalOpt.line_comment option;
 
   enqueue      : 'token -> 'token state;
   set_units    : (Markup.t list * 'token) FQueue.t -> 'token state;
@@ -184,25 +188,28 @@ type 'token state = <
   push_tabs    : Lexing.lexbuf -> 'token state;
   push_bom     : Lexing.lexbuf -> 'token state;
   push_markup  : Markup.t -> 'token state;
+  push_comment : Markup.comment -> 'token state
 >
 
-let mk_state ~units ~markup ~window ~last ~pos ~decoder ~supply
+let mk_state ~units ~markup ~comments ~window ~last ~pos ~decoder ~supply
              ?block ?line () : _ state =
   object (self)
-    val units      = units
+    val units       = units
-    method units   = units
+    method units    = units
-    val markup     = markup
+    val markup      = markup
-    method markup  = markup
+    method markup   = markup
-    val window     = window
+    val comments    = comments
-    method window  = window
+    method comments = comments
-    val last       = last
+    val window      = window
-    method last    = last
+    method window   = window
-    val pos        = pos
+    val last        = last
-    method pos     = pos
+    method last     = last
-    method decoder = decoder
+    val pos         = pos
-    method supply  = supply
+    method pos      = pos
-    method block   = block
+    method decoder  = decoder
-    method line    = line
+    method supply   = supply
+    method block    = block
+    method line     = line
 
     method enqueue token =
       {< units  = FQueue.enq (markup, token) units;
@@ -229,6 +236,9 @@ let mk_state ~units ~markup ~window ~last ~pos ~decoder ~supply
 
     (* Committing markup to the current logical state *)
 
+    method push_comment comment =
+      {< comments = FQueue.enq comment comments >}
+
     method push_markup unit = {< markup = unit :: markup >}
 
     method push_newline buffer =
@@ -238,21 +248,23 @@ let mk_state ~units ~markup ~window ~last ~pos ~decoder ~supply
       let stop   = start#new_line value in
       let region = Region.make ~start ~stop in
       let unit   = Markup.Newline Region.{region; value}
-      in {< pos = stop; markup = unit::markup >}
+      in (self#push_markup unit)#set_pos stop
 
     method push_line thread =
       let start  = thread#opening#start in
       let region = Region.make ~start ~stop:self#pos
       and value  = thread#to_string in
-      let unit   = Markup.LineCom Region.{region; value}
+      let reg    = Region.{region; value} in
-      in {< markup = unit::markup >}
+      let unit   = Markup.LineCom reg
+      in (self#push_markup unit)#push_comment (Markup.Line reg)
 
     method push_block thread =
       let start  = thread#opening#start in
       let region = Region.make ~start ~stop:self#pos
       and value  = thread#to_string in
-      let unit   = Markup.BlockCom Region.{region; value}
+      let reg    = Region.{region; value} in
-      in {< markup = unit::markup >}
+      let unit   = Markup.BlockCom reg
+      in (self#push_markup unit)#push_comment (Markup.Block reg)
 
     method push_space buffer =
       let region, lex, state = self#sync buffer in
@@ -283,14 +295,15 @@ type input =
 type 'token logger = Markup.t list -> 'token -> unit
 
 type 'token instance = {
-  input    : input;
+  input        : input;
-  read     : log:('token logger) -> Lexing.lexbuf -> 'token;
+  read         : log:('token logger) -> Lexing.lexbuf -> 'token;
-  buffer   : Lexing.lexbuf;
+  buffer       : Lexing.lexbuf;
-  get_win  : unit -> 'token window;
+  close        : unit -> unit;
-  get_pos  : unit -> Pos.t;
+  get_win      : unit -> 'token window;
-  get_last : unit -> Region.t;
+  get_pos      : unit -> Pos.t;
-  get_file : unit -> file_path;
+  get_last     : unit -> Region.t;
-  close    : unit -> unit
+  get_file     : unit -> file_path;
+  get_comments : unit -> Markup.comment FQueue.t
 }
 
 type open_err = File_opening of string
@@ -329,15 +342,18 @@ let open_token_stream ?line ?block ~scan
                           ~window:Nil
                           ~pos
                           ~markup:[]
+                          ~comments:FQueue.empty
                           ~decoder
                           ~supply
                           ?block
                           ?line
                           ()) in
-  let get_pos  () = !state#pos
+
-  and get_last () = !state#last
+  let get_pos      () = !state#pos
-  and get_win  () = !state#window
+  and get_last     () = !state#last
-  and get_file () = file_path in
+  and get_win      () = !state#window
+  and get_comments () = !state#comments
+  and get_file     () = file_path in
 
   let patch_buffer (start, stop) buffer =
     let open Lexing in
@@ -368,8 +384,8 @@ let open_token_stream ?line ?block ~scan
     | Some (units, (left_mark, token)) ->
         log left_mark token;
         state := ((!state#set_units units)
-                    #set_last (token_to_region token))
+                         #set_last (token_to_region token))
-                   #slide_token token;
+                         #slide_token token;
         style token (next_token scan) buffer;
         patch_buffer (token_to_region token)#byte_pos buffer;
         token in
@@ -382,6 +398,7 @@ let open_token_stream ?line ?block ~scan
         | _ -> () in
       let instance = {
         read = read scan ~token_to_region ~style;
-        input; buffer; get_win; get_pos; get_last; get_file; close}
+        input; buffer; close;
+        get_win; get_pos; get_last; get_file; get_comments}
       in Ok instance
   | Error _ as e -> e

src/passes/01-parsing/shared/LexerLib.mli

@@ -1,7 +1,8 @@
 (* A library for writing UTF8-aware lexers *)
 
 module Region = Simple_utils.Region
-module Pos = Simple_utils.Pos
+module Pos    = Simple_utils.Pos
+module FQueue = Simple_utils.FQueue
 
 (* The function [rollback] resets the lexing buffer to the state it
    was when it matched the last regular expression. This function is
@@ -39,7 +40,7 @@ type thread = <
   set_opening : Region.t -> thread
 >
 
-val mk_thread : Region.t -> lexeme -> thread
+val mk_thread : Region.t -> thread
 
 (* STATE *)
 
@@ -108,15 +109,16 @@ type 'token window =
 | Two of 'token * 'token
 
 type 'token state = <
-  units   : (Markup.t list * 'token) FQueue.t;
+  units    : (Markup.t list * 'token) FQueue.t;
-  markup  : Markup.t list;
+  markup   : Markup.t list;
-  window  : 'token window;
+  comments : Markup.comment FQueue.t;
-  last    : Region.t;
+  window   : 'token window;
-  pos     : Pos.t;
+  last     : Region.t;
-  decoder : Uutf.decoder;
+  pos      : Pos.t;
-  supply  : Bytes.t -> int -> int -> unit;
+  decoder  : Uutf.decoder;
-  block   : EvalOpt.block_comment option;
+  supply   : Bytes.t -> int -> int -> unit;
-  line    : EvalOpt.line_comment option;
+  block    : EvalOpt.block_comment option;
+  line     : EvalOpt.line_comment option;
 
   enqueue      : 'token -> 'token state;
   set_units    : (Markup.t list * 'token) FQueue.t -> 'token state;
@@ -133,6 +135,7 @@ type 'token state = <
   push_tabs    : Lexing.lexbuf -> 'token state;
   push_bom     : Lexing.lexbuf -> 'token state;
   push_markup  : Markup.t -> 'token state;
+  push_comment : Markup.comment -> 'token state
 >
 
 (* LEXER INSTANCE *)
@@ -178,11 +181,12 @@ type 'token instance = {
   input    : input;
   read     : log:('token logger) -> Lexing.lexbuf -> 'token;
   buffer   : Lexing.lexbuf;
+  close    : unit -> unit;
   get_win  : unit -> 'token window;
   get_pos  : unit -> Pos.t;
   get_last : unit -> Region.t;
   get_file : unit -> file_path;
-  close    : unit -> unit
+  get_comments : unit -> Markup.comment FQueue.t
 }
 
 type open_err = File_opening of string

src/passes/01-parsing/shared/Markup.ml

@@ -42,3 +42,9 @@ let to_string markup ?(offsets=true) mode =
         region, sprintf "BOM \"%s\"" (String.escaped value) in
   let reg_str = region#compact ~offsets mode
   in sprintf "%s: %s" reg_str val_str
+
+(* Comments *)
+
+type comment =
+  Line  of lexeme Region.reg
+| Block of lexeme Region.reg

src/passes/01-parsing/shared/Markup.mli

@@ -1,11 +1,12 @@
-(** This module defines the sorts of markup recognised by the LIGO
+(* This module defines the sorts of markup recognised by the LIGO
    lexer *)
 
 module Region = Simple_utils.Region
 
-(** A lexeme is piece of concrete syntax belonging to a token. In
+(* A lexeme is piece of concrete syntax belonging to a token. In
    algebraic terms, a token is also a piece of abstract lexical
    syntax. Lexical units emcompass both markup and lexemes. *)
+
 type lexeme = string
 
 type t =
@@ -18,7 +19,7 @@ type t =
 
 type markup = t
 
-(** Pretty-printing of markup
+(* Pretty-printing of markup
 
    The difference between [to_lexeme] and [to_string] is that the
    former builds the corresponding concrete syntax (the lexeme),
@@ -31,3 +32,9 @@ type markup = t
 
 val to_lexeme : t -> lexeme
 val to_string : t -> ?offsets:bool -> [`Byte | `Point] -> string
+
+(* Comments *)
+
+type comment =
+  Line  of lexeme Region.reg
+| Block of lexeme Region.reg

src/passes/01-parsing/shared/ParserAPI.ml

@@ -1,6 +1,14 @@
 (* Generic parser for LIGO *)
 
-module Region = Simple_utils.Region
+(* Dependencies *)
+
+module Region   = Simple_utils.Region
+module EvalOpt  = Lexer_shared.EvalOpt
+module Lexer    = Lexer_shared.Lexer
+module LexerLib = Lexer_shared.LexerLib
+module LexerLog = Lexer_shared.LexerLog
+
+(* Input/Output *)
 
 type options = <
   offsets : bool;

src/passes/01-parsing/shared/ParserAPI.mli

@@ -1,6 +1,13 @@
 (* Generic parser API for LIGO *)
 
-module Region = Simple_utils.Region
+(* Dependencies *)
+
+module Region   = Simple_utils.Region
+module EvalOpt  = Lexer_shared.EvalOpt
+module Lexer    = Lexer_shared.Lexer
+module LexerLib = Lexer_shared.LexerLib
+
+(* Input/Output *)
 
 type options = <
   offsets : bool;

src/passes/01-parsing/shared/ParserUnit.ml

@@ -1,8 +1,16 @@
 (* Functor to build a LIGO parser *)
 
-module Region  = Simple_utils.Region
+(* Dependencies *)
-module Preproc = Preprocessor.Preproc
+
-module SSet    = Set.Make (String)
+module Region   = Simple_utils.Region
+module EvalOpt  = Lexer_shared.EvalOpt
+module Lexer    = Lexer_shared.Lexer
+module LexerLib = Lexer_shared.LexerLib
+module LexerLog = Lexer_shared.LexerLog
+module Preproc  = Preprocessor.Preproc
+module SSet     = Set.Make (String)
+
+(* A subtype of [EvalOpt.options] *)
 
 module type SubIO =
   sig

src/passes/01-parsing/shared/ParserUnit.mli

@@ -1,8 +1,12 @@
 (* Functor to build a standalone LIGO parser *)
 
-module Region = Simple_utils.Region
+(* Dependencies *)
 
-module SSet : Set.S with type elt = string and type t = Set.Make(String).t
+module Region  = Simple_utils.Region
+module EvalOpt = Lexer_shared.EvalOpt
+module Lexer   = Lexer_shared.Lexer
+module SSet    : Set.S with type elt = string
+                        and type t = Set.Make(String).t
 
 (* A subtype of [EvalOpt.options] *)
 

src/passes/01-parsing/shared/dune

@@ -1,29 +1,51 @@
+;; Build of the lexer in common to all Ligo's dialects
+
 (ocamllex Lexer)
 
+;; Build of the lexer as a library
+
+(library
+  (name lexer_shared)
+  (public_name ligo.lexer.shared)
+  (libraries
+    ;; Ligo
+    simple-utils
+    ;; Vendors
+    Preprocessor
+    ;; Third party
+    uutf
+    getopt
+    zarith)
+  (modules
+    LexerLib
+    LexerUnit
+    Lexer
+    LexerLog
+    Markup
+    EvalOpt
+    Version)
+  (preprocess
+   (pps bisect_ppx --conditional)))
+
+;; Build of the parser as a library
+
 (library
   (name parser_shared)
   (public_name ligo.parser.shared)
   (libraries
-    menhirLib
+    ;; Ligo
+    lexer_shared
     simple-utils
-    uutf
+    ;; Third party
-    getopt
+    menhirLib)
-    zarith
-    Preprocessor)
-  (preprocess
-    (pps bisect_ppx --conditional))
   (modules
-    LexerLib
-    LexerUnit
     ParserUnit
-    ParserAPI
+    ParserAPI)
-    Lexer
+  (preprocess
-    LexerLog
+    (pps bisect_ppx --conditional)))
-    Markup
+;;  (flags (:standard -open Lexer_shared)))
-    Utils
+
-    FQueue
+;; Build of the version source (for the user, as a CLI option)
-    EvalOpt
-    Version))
 
 (rule
   (targets Version.ml)

src/passes/03-tree_abstraction/cameligo/decompiler.ml

@@ -13,14 +13,14 @@ let wrap : type a. a -> a CST.reg = fun value -> {value;region=rg}
 let list_to_sepseq lst =
   match lst with
     [] -> None
-  |  hd :: lst -> 
+  |  hd :: lst ->
       let aux e = (rg, e) in
       Some (hd, List.map aux lst)
-let list_to_nsepseq lst = 
+let list_to_nsepseq lst =
   match list_to_sepseq lst with
     Some s -> ok @@ s
   | None   -> failwith "List is empty"
-    
+
 let nelist_to_npseq (hd, lst) = (hd, List.map (fun e -> (rg, e)) lst)
 let npseq_cons hd lst = hd,(rg, fst lst)::(snd lst)
 
@@ -39,7 +39,7 @@ let decompile_variable : type a. a Var.t -> CST.variable = fun var ->
   if String.contains var '#' then
     let var = String.split_on_char '#' var in
     wrap @@ "gen__" ^ (String.concat "" var)
-  else 
+  else
     if String.length var > 4 && String.equal "gen__" @@ String.sub var 0 5 then
       wrap @@ "user__" ^ var
     else
@@ -51,23 +51,23 @@ let rec decompile_type_expr : AST.type_expression -> _ result = fun te ->
     T_sum sum ->
     let sum = AST.CMap.to_kv_list sum in
     let aux (AST.Constructor c, AST.{ctor_type;_}) =
-      let constr = wrap c in 
+      let constr = wrap c in
       let%bind arg = decompile_type_expr ctor_type in
       let arg = Some (rg, arg) in
       let variant : CST.variant = {constr;arg} in
-      ok @@ wrap variant 
+      ok @@ wrap variant
     in
     let%bind sum = bind_map_list aux sum in
     let%bind sum = list_to_nsepseq sum in
     return @@ CST.TSum (wrap sum)
-  | T_record record -> 
+  | T_record record ->
     let record = AST.LMap.to_kv_list record in
     let aux (AST.Label c, AST.{field_type;_}) =
-      let field_name = wrap c in 
+      let field_name = wrap c in
       let colon = rg in
       let%bind field_type = decompile_type_expr field_type in
       let variant : CST.field_decl = {field_name;colon;field_type} in
-      ok @@ wrap variant 
+      ok @@ wrap variant
     in
     let%bind record = bind_map_list aux record in
     let%bind record = list_to_nsepseq record in
@@ -97,27 +97,27 @@ let rec decompile_type_expr : AST.type_expression -> _ result = fun te ->
     failwith "let's work on it later"
 
 let get_e_variable : AST.expression -> _ result = fun expr ->
-  match expr.expression_content with 
+  match expr.expression_content with
     E_variable var -> ok @@ var.wrap_content
-  | _ -> failwith @@ 
+  | _ -> failwith @@
     Format.asprintf "%a should be a variable expression"
     AST.PP.expression expr
 
 let get_e_tuple : AST.expression -> _ result = fun expr ->
-  match expr.expression_content with 
+  match expr.expression_content with
     E_tuple tuple -> ok @@ tuple
   | E_variable _
   | E_literal _
   | E_constant _
   | E_lambda _ -> ok @@ [expr]
-  | _ -> failwith @@ 
+  | _ -> failwith @@
     Format.asprintf "%a should be a tuple expression"
     AST.PP.expression expr
 
 let pattern_type var ty_opt =
   let var = CST.PVar (decompile_variable var) in
   match ty_opt with
-    Some s -> 
+    Some s ->
       let%bind type_expr = decompile_type_expr s in
       ok @@ CST.PTyped (wrap @@ CST.{pattern=var;colon=rg;type_expr})
   | None -> ok @@ var
@@ -126,7 +126,7 @@ let rec decompile_expression : AST.expression -> _ result = fun expr ->
   let return_expr expr = ok @@ expr in
   let return_expr_with_par expr = return_expr @@ CST.EPar (wrap @@ par @@ expr) in
   match expr.expression_content with
-    E_variable name -> 
+    E_variable name ->
     let var = decompile_variable name.wrap_content in
     return_expr @@ CST.EVar (var)
   | E_constant {cons_name; arguments} ->
@@ -145,7 +145,7 @@ let rec decompile_expression : AST.expression -> _ result = fun expr ->
         Literal_unit  ->  return_expr @@ CST.EUnit (wrap (rg,rg))
       | Literal_int i ->  return_expr @@ CST.EArith (Int (wrap ("",i)))
       | Literal_nat n ->  return_expr @@ CST.EArith (Nat (wrap ("",n)))
-      | Literal_timestamp time -> 
+      | Literal_timestamp time ->
         let time = Tezos_utils.Time.Protocol.to_notation @@
           Tezos_utils.Time.Protocol.of_seconds @@ Z.to_int64 time in
           (* TODO combinators for CSTs. *)
@@ -175,15 +175,15 @@ let rec decompile_expression : AST.expression -> _ result = fun expr ->
         let kh = CST.EString (String (wrap kh)) in
         let%bind ty = decompile_type_expr @@ AST.t_key_hash () in
         return_expr @@ CST.EAnnot (wrap @@ par (kh,rg,ty))
-      | Literal_chain_id _ 
+      | Literal_chain_id _
       | Literal_void
       | Literal_operation _ ->
         failwith "chain_id, void, operation are not created currently ?"
     )
   | E_application {lamb;args} ->
     let%bind lamb = decompile_expression lamb in
-    let%bind args = map List.Ne.of_list @@ 
+    let%bind args = map List.Ne.of_list @@
-      bind (bind_map_list decompile_expression) @@ 
+      bind (bind_map_list decompile_expression) @@
       get_e_tuple args
     in
     return_expr @@ CST.ECall (wrap (lamb,args))
@@ -220,7 +220,7 @@ let rec decompile_expression : AST.expression -> _ result = fun expr ->
     return_expr @@ CST.ECase (wrap cases)
   | E_record record  ->
     let record = AST.LMap.to_kv_list record in
-    let aux (AST.Label str, expr) = 
+    let aux (AST.Label str, expr) =
       let field_name = wrap str in
       let%bind field_expr = decompile_expression expr in
       let field : CST.field_assign = {field_name;assignment=rg;field_expr} in
@@ -256,10 +256,10 @@ let rec decompile_expression : AST.expression -> _ result = fun expr ->
   | E_update {record={expression_content=E_update _;_} as record;path;update} ->
     let%bind record = decompile_expression record in
     let%bind (record,updates) = match record with
-      CST.EUpdate {value;_} -> ok @@ (value.record,value.updates) 
+      CST.EUpdate {value;_} -> ok @@ (value.record,value.updates)
-    | _ -> failwith @@ Format.asprintf "Inpossible case %a" AST.PP.expression expr 
+    | _ -> failwith @@ Format.asprintf "Inpossible case %a" AST.PP.expression expr
     in
-    let%bind var,path = match path with 
+    let%bind var,path = match path with
       Access_record var::path -> ok @@ (var,path)
     | _ -> failwith "Impossible case %a"
     in
@@ -275,7 +275,7 @@ let rec decompile_expression : AST.expression -> _ result = fun expr ->
     let%bind field_expr = decompile_expression update in
     let (struct_name,field_path) = List.Ne.of_list path in
     (match field_path with
-      [] -> 
+      [] ->
       (match struct_name with
         Access_record name ->
         let record : CST.path = Name record in
@@ -299,7 +299,7 @@ let rec decompile_expression : AST.expression -> _ result = fun expr ->
     | _ ->
       let%bind struct_name = match struct_name with
           Access_record name -> ok @@ wrap name
-        | Access_tuple i -> ok @@ wrap @@ Z.to_string i 
+        | Access_tuple i -> ok @@ wrap @@ Z.to_string i
         | Access_map _ -> failwith @@ Format.asprintf "invalid map update %a" AST.PP.expression expr
       in
       (match List.rev field_path with
@@ -347,7 +347,7 @@ let rec decompile_expression : AST.expression -> _ result = fun expr ->
     let%bind map = bind_map_list (bind_map_pair decompile_expression) map in
     let aux (k,v) = CST.ETuple (wrap (k,[(rg,v)])) in
     let map = List.map aux map in
-    (match map with 
+    (match map with
       [] -> return_expr @@ CST.EVar (wrap "Big_map.empty")
     | _  ->
       let var = CST.EVar (wrap "Map.literal") in
@@ -357,7 +357,7 @@ let rec decompile_expression : AST.expression -> _ result = fun expr ->
     let%bind big_map = bind_map_list (bind_map_pair decompile_expression) big_map in
     let aux (k,v) = CST.ETuple (wrap (k,[(rg,v)])) in
     let big_map = List.map aux big_map in
-    (match big_map with 
+    (match big_map with
       [] -> return_expr @@ CST.EVar (wrap "Big_map.empty")
     | _  ->
       let var = CST.EVar (wrap "Big_map.literal") in
@@ -409,28 +409,28 @@ and decompile_attributes = function
     true -> [wrap "inline"]
   | false -> []
 
-and decompile_matching_cases : AST.matching_expr -> ((CST.expr CST.case_clause Region.reg, Region.t) Parser_shared.Utils.nsepseq Region.reg,_) result = 
+and decompile_matching_cases : AST.matching_expr -> ((CST.expr CST.case_clause Region.reg, Region.t) Simple_utils.Utils.nsepseq Region.reg,_) result =
 fun m ->
   let%bind cases = match m with
     Match_variable (var, ty_opt, expr) ->
-    let%bind pattern = pattern_type var.wrap_content ty_opt in 
+    let%bind pattern = pattern_type var.wrap_content ty_opt in
     let%bind rhs = decompile_expression expr in
     let case : _ CST.case_clause = {pattern; arrow=rg; rhs}in
     ok @@ [wrap case]
   | Match_tuple (lst, ty_opt, expr) ->
-    let%bind tuple = match ty_opt with 
+    let%bind tuple = match ty_opt with
       Some ty_lst ->
-      let aux (var, ty) = 
+      let aux (var, ty) =
         let pattern = CST.PVar (decompile_variable var) in
         let%bind type_expr = decompile_type_expr ty in
-        ok @@ CST.PTyped (wrap @@ CST.{pattern;colon=rg;type_expr}) 
+        ok @@ CST.PTyped (wrap @@ CST.{pattern;colon=rg;type_expr})
       in
       bind list_to_nsepseq @@ bind_map_list aux @@ List.combine (List.map (fun (e:AST.expression_variable) -> e.wrap_content) lst) ty_lst
     | None ->
       let aux (var:AST.expression_variable) = CST.PVar (decompile_variable var.wrap_content) in
-      list_to_nsepseq @@ List.map aux lst 
+      list_to_nsepseq @@ List.map aux lst
     in
-    let pattern : CST.pattern = PTuple (wrap @@ tuple) in 
+    let pattern : CST.pattern = PTuple (wrap @@ tuple) in
     let%bind rhs = decompile_expression expr in
     let case : _ CST.case_clause = {pattern; arrow=rg; rhs}in
     ok @@ [wrap case]
@@ -453,7 +453,7 @@ fun m ->
     let nil_case : _ CST.case_clause = {pattern=PList (PListComp (wrap @@ inject brackets None));arrow=rg; rhs} in
     ok @@ [wrap cons_case; wrap nil_case]
   | Match_variant lst ->
-    let aux ((c,(v:AST.expression_variable)),e) = 
+    let aux ((c,(v:AST.expression_variable)),e) =
       let AST.Constructor c = c in
       let constr = wrap @@ c in
       let var : CST.pattern = PVar (decompile_variable v.wrap_content) in

src/passes/03-tree_abstraction/pascaligo/compiler.ml

@@ -584,7 +584,6 @@ and compile_instruction : ?next: AST.expression -> CST.instruction -> _ result
       let%bind (_, var, path) = compile_path mlu.path in
       let%bind index = compile_expression @@ mlu.index.value.inside in
       ok @@ (var, path @ [Access_map index])
-
   in
   match instruction with
     Cond c ->
@@ -747,8 +746,8 @@ and compile_block : ?next:AST.expression -> CST.block CST.reg -> _ result = fun
   let (block', _loc) = r_split block in
   let statements = npseq_to_list block'.statements in
   let aux (next,attr) statement =
-    let%bind (statement, attr) = compile_statement ?next attr statement in
+    let%bind (statement, attr) = compile_statement ?next attr statement
-    return (statement,attr)
+    in return (statement,attr)
   in
   let%bind (block', _) = bind_fold_right_list aux (next,None) statements in
   match block' with

src/passes/03-tree_abstraction/pascaligo/decompiler.ml

@@ -13,10 +13,10 @@ let wrap : type a. a -> a CST.reg = fun value -> {value;region=rg}
 let list_to_sepseq lst =
   match lst with
     [] -> None
-  |  hd :: lst -> 
+  |  hd :: lst ->
       let aux e = (rg, e) in
       Some (hd, List.map aux lst)
-let list_to_nsepseq lst = 
+let list_to_nsepseq lst =
   match list_to_sepseq lst with
     Some s -> ok @@ s
   | None   -> failwith "List is not a non_empty list"
@@ -40,7 +40,7 @@ let decompile_variable : type a. a Var.t -> CST.variable = fun var ->
   if String.contains var '#' then
     let var = String.split_on_char '#' var in
     wrap @@ "gen__" ^ (String.concat "" var)
-  else 
+  else
     if String.length var > 4 && String.equal "gen__" @@ String.sub var 0 5 then
       wrap @@ "user__" ^ var
     else
@@ -52,23 +52,23 @@ let rec decompile_type_expr : AST.type_expression -> _ result = fun te ->
     T_sum sum ->
     let sum = AST.CMap.to_kv_list sum in
     let aux (AST.Constructor c, AST.{ctor_type;_}) =
-      let constr = wrap c in 
+      let constr = wrap c in
       let%bind arg = decompile_type_expr ctor_type in
       let arg = Some (rg, arg) in
       let variant : CST.variant = {constr;arg} in
-      ok @@ wrap variant 
+      ok @@ wrap variant
     in
     let%bind sum = bind_map_list aux sum in
     let%bind sum = list_to_nsepseq sum in
     return @@ CST.TSum (wrap sum)
-  | T_record record -> 
+  | T_record record ->
     let record = AST.LMap.to_kv_list record in
     let aux (AST.Label c, AST.{field_type;_}) =
-      let field_name = wrap c in 
+      let field_name = wrap c in
       let colon = rg in
       let%bind field_type = decompile_type_expr field_type in
       let variant : CST.field_decl = {field_name;colon;field_type} in
-      ok @@ wrap variant 
+      ok @@ wrap variant
     in
     let%bind record = bind_map_list aux record in
     let%bind record = list_to_nsepseq record in
@@ -98,30 +98,30 @@ let rec decompile_type_expr : AST.type_expression -> _ result = fun te ->
     failwith "let's work on it later"
 
 let get_e_variable : AST.expression -> _ result = fun expr ->
-  match expr.expression_content with 
+  match expr.expression_content with
     E_variable var -> ok @@ var.wrap_content
-  | _ -> failwith @@ 
+  | _ -> failwith @@
     Format.asprintf "%a should be a variable expression"
     AST.PP.expression expr
- 
+
 let rec get_e_accessor : AST.expression -> _ result = fun expr ->
-  match expr.expression_content with 
+  match expr.expression_content with
     E_variable var -> ok @@ (var, [])
   | E_accessor {record;path} ->
     let%bind (var, lst) = get_e_accessor record in
     ok @@ (var, lst @ path)
-  | _ -> failwith @@ 
+  | _ -> failwith @@
     Format.asprintf "%a should be a variable expression"
     AST.PP.expression expr
 
 let get_e_tuple : AST.expression -> _ result = fun expr ->
-  match expr.expression_content with 
+  match expr.expression_content with
     E_tuple tuple -> ok @@ tuple
   | E_variable _
   | E_literal _
   | E_constant _
   | E_lambda _ -> ok @@ [expr]
-  | _ -> failwith @@ 
+  | _ -> failwith @@
     Format.asprintf "%a should be a tuple expression"
     AST.PP.expression expr
 type eos =
@@ -138,7 +138,7 @@ let statements_of_expression : CST.expr -> CST.statement List.Ne.t option = fun
 let rec decompile_expression : AST.expression -> _ result = fun e ->
   let%bind (block,expr) = decompile_to_block e in
   match expr with
-    Some expr -> 
+    Some expr ->
     ( match block with
       Some block ->
         let block = wrap @@ block in
@@ -146,7 +146,7 @@ let rec decompile_expression : AST.expression -> _ result = fun e ->
     | None -> ok @@ expr
     )
   | None ->
-    failwith @@ Format.asprintf 
+    failwith @@ Format.asprintf
       "An expression was expected, but this was decompile to statements. \n
       Expr : %a
       Loc : %a"
@@ -157,8 +157,8 @@ and decompile_statements : AST.expression -> _ result = fun expr ->
   let%bind (stat,_) = decompile_eos Statements expr in
   match stat with
     Some stat -> ok @@ stat
-  | None -> 
+  | None ->
-      failwith @@ Format.asprintf 
+      failwith @@ Format.asprintf
         "Statements was expected, but this was decompile to expression. \n
         Expr : %a
         Loc : %a"
@@ -185,7 +185,7 @@ and decompile_eos : eos -> AST.expression -> ((CST.statement List.Ne.t option)*
   let return_stat_ez stat = return_stat @@ (stat, []) in
   let return_inst inst = return_stat_ez @@ CST.Instr inst in
   match expr.expression_content with
-    E_variable name -> 
+    E_variable name ->
     let var = decompile_variable name.wrap_content in
     return_expr @@ CST.EVar (var)
   | E_constant {cons_name; arguments} ->
@@ -195,7 +195,7 @@ and decompile_eos : eos -> AST.expression -> ((CST.statement List.Ne.t option)*
     | _ ->
       let%bind arguments = decompile_to_tuple_expr arguments in
       let const : CST.fun_call = wrap (expr, arguments) in
-      (match output with 
+      (match output with
         Expression -> return_expr (CST.ECall const)
       | Statements -> return_inst (CST.ProcCall const)
       )
@@ -205,7 +205,7 @@ and decompile_eos : eos -> AST.expression -> ((CST.statement List.Ne.t option)*
         Literal_unit  ->  return_expr @@ CST.EUnit rg
       | Literal_int i ->  return_expr @@ CST.EArith (Int (wrap ("",i)))
       | Literal_nat n ->  return_expr @@ CST.EArith (Nat (wrap ("",n)))
-      | Literal_timestamp time -> 
+      | Literal_timestamp time ->
         let time = Tezos_utils.Time.Protocol.to_notation @@
           Tezos_utils.Time.Protocol.of_seconds @@ Z.to_int64 time in
           (* TODO combinators for CSTs. *)
@@ -235,7 +235,7 @@ and decompile_eos : eos -> AST.expression -> ((CST.statement List.Ne.t option)*
         let kh = CST.EString (String (wrap kh)) in
         let%bind ty = decompile_type_expr @@ AST.t_key_hash () in
         return_expr @@ CST.EAnnot (wrap @@ par (kh,rg,ty))
-      | Literal_chain_id _ 
+      | Literal_chain_id _
       | Literal_void
       | Literal_operation _ ->
         failwith "chain_id, void, operation are not created currently ?"
@@ -244,7 +244,7 @@ and decompile_eos : eos -> AST.expression -> ((CST.statement List.Ne.t option)*
     let%bind lamb = decompile_expression lamb in
     let%bind args = bind decompile_to_tuple_expr @@ get_e_tuple args in
     (match output with
-      Expression -> 
+      Expression ->
       return_expr @@ CST.ECall (wrap (lamb,args))
     | Statements ->
       return_inst @@ CST.ProcCall (wrap (lamb,args))
@@ -281,7 +281,7 @@ and decompile_eos : eos -> AST.expression -> ((CST.statement List.Ne.t option)*
   | E_let_in {let_binder;rhs;let_result;inline} ->
     let%bind lin = decompile_to_data_decl let_binder rhs inline in
     let%bind (lst, expr) = decompile_eos Expression let_result in
-    let lst = match lst with 
+    let lst = match lst with
       Some lst -> List.Ne.cons (CST.Data lin) lst
     | None -> (CST.Data lin, [])
     in
@@ -310,7 +310,7 @@ and decompile_eos : eos -> AST.expression -> ((CST.statement List.Ne.t option)*
     )
   | E_record record  ->
     let record = AST.LMap.to_kv_list record in
-    let aux (AST.Label str, expr) = 
+    let aux (AST.Label str, expr) =
       let field_name = wrap str in
       let%bind field_expr = decompile_expression expr in
       let field : CST.field_assignment = {field_name;assignment=rg;field_expr} in
@@ -350,10 +350,10 @@ and decompile_eos : eos -> AST.expression -> ((CST.statement List.Ne.t option)*
   | E_update {record={expression_content=E_update _;_} as record;path;update} ->
     let%bind record = decompile_expression record in
     let%bind (record,updates) = match record with
-      CST.EUpdate {value;_} -> ok @@ (value.record,value.updates) 
+      CST.EUpdate {value;_} -> ok @@ (value.record,value.updates)
-    | _ -> failwith @@ Format.asprintf "Inpossible case %a" AST.PP.expression expr 
+    | _ -> failwith @@ Format.asprintf "Inpossible case %a" AST.PP.expression expr
     in
-    let%bind var,path = match path with 
+    let%bind var,path = match path with
       Access_record var::path -> ok @@ (var,path)
     | _ -> failwith "Impossible case %a"
     in
@@ -369,7 +369,7 @@ and decompile_eos : eos -> AST.expression -> ((CST.statement List.Ne.t option)*
     let%bind field_expr = decompile_expression update in
     let (struct_name,field_path) = List.Ne.of_list path in
     (match field_path with
-      [] -> 
+      [] ->
       (match struct_name with
         Access_record name ->
         let record : CST.path = Name record in
@@ -483,7 +483,7 @@ and decompile_eos : eos -> AST.expression -> ((CST.statement List.Ne.t option)*
     let var = decompile_variable @@ (fst binder).wrap_content in
     let bind_to = Option.map (fun (x:AST.expression_variable) -> (rg,decompile_variable x.wrap_content)) @@ snd binder in
     let%bind expr = decompile_expression collection in
-    let collection = match collection_type with 
+    let collection = match collection_type with
       Map -> CST.Map rg | Set -> Set rg | List -> List rg in
     let%bind (block,_next) = decompile_to_block body in
     let block = wrap @@ Option.unopt ~default:(empty_block) block in
@@ -498,7 +498,7 @@ and decompile_eos : eos -> AST.expression -> ((CST.statement List.Ne.t option)*
 
 and decompile_if_clause : AST.expression -> (CST.if_clause, _) result = fun e ->
   let%bind clause = decompile_statements e in
-  match clause with 
+  match clause with
     CST.Instr instr,[] ->
     ok @@ CST.ClauseInstr instr
   | _ ->
@@ -508,12 +508,12 @@ and decompile_if_clause : AST.expression -> (CST.if_clause, _) result = fun e ->
 and decompile_to_data_decl : (AST.expression_variable * AST.type_expression option) -> AST.expression -> bool -> (CST.data_decl, _) result = fun (name,ty_opt) expr inline ->
   let name = decompile_variable name.wrap_content in
   let%bind const_type = bind_map_option (bind_compose (ok <@ prefix_colon) decompile_type_expr) ty_opt in
-  let attributes : CST.attr_decl option = match inline with 
+  let attributes : CST.attr_decl option = match inline with
     true -> Some (wrap @@ ne_inject (NEInjAttr rg) @@ (wrap @@ "inline",[]))
   | false -> None
   in
   let fun_name = name in
-  match expr.expression_content with 
+  match expr.expression_content with
     E_lambda lambda ->
     let%bind (param,ret_type,return) = decompile_lambda lambda in
     let fun_decl : CST.fun_decl = {kwd_recursive=None;kwd_function=rg;fun_name;param;ret_type;kwd_is=rg;return;terminator=Some rg;attributes} in
@@ -531,14 +531,14 @@ and decompile_to_data_decl : (AST.expression_variable * AST.type_expression opti
 and decompile_to_lhs : AST.expression_variable -> AST.access list -> (CST.lhs, _) result = fun var access ->
   match List.rev access with
     [] -> ok @@ (CST.Path (Name (decompile_variable var.wrap_content)) : CST.lhs)
-  | hd :: tl -> 
+  | hd :: tl ->
-    match hd with 
+    match hd with
     | AST.Access_map e ->
       let%bind path = decompile_to_path var @@ List.rev tl in
       let%bind index = map (wrap <@ brackets) @@ decompile_expression e in
       let mlu: CST.map_lookup = {path;index} in
       ok @@ CST.MapPath (wrap @@ mlu)
-    | _ -> 
+    | _ ->
       let%bind path = decompile_to_path var @@ access in
       ok @@ (CST.Path (path) : CST.lhs)
 
@@ -570,18 +570,18 @@ and decompile_lambda : AST.lambda -> _ = fun {binder;input_type;output_type;resu
     let%bind return = decompile_expression result in
     ok @@ (param,ret_type,return)
 
-and decompile_matching_expr : type a.(AST.expr ->(a,_) result) -> AST.matching_expr -> ((a CST.case_clause Region.reg, Region.t) Parser_shared.Utils.nsepseq Region.reg,_) result = 
+and decompile_matching_expr : type a.(AST.expr ->(a,_) result) -> AST.matching_expr -> ((a CST.case_clause Region.reg, Region.t) Simple_utils.Utils.nsepseq Region.reg,_) result =
 fun f m ->
   let%bind cases = match m with
     Match_variable (var, _ty_opt, expr) ->
-    let pattern : CST.pattern = PVar (decompile_variable var.wrap_content) in 
+    let pattern : CST.pattern = PVar (decompile_variable var.wrap_content) in
     let%bind rhs = f expr in
     let case : _ CST.case_clause = {pattern; arrow=rg; rhs}in
     ok @@ [wrap case]
   | Match_tuple (lst, _ty_opt, expr) ->
     let aux (var:AST.expression_variable) = CST.PVar (decompile_variable var.wrap_content) in
     let%bind tuple = list_to_nsepseq @@ List.map aux lst in
-    let pattern : CST.pattern = PTuple (wrap @@ par @@ tuple) in 
+    let pattern : CST.pattern = PTuple (wrap @@ par @@ tuple) in
     let%bind rhs = f expr in
     let case : _ CST.case_clause = {pattern; arrow=rg; rhs}in
     ok @@ [wrap case]
@@ -604,7 +604,7 @@ fun f m ->
     let nil_case : _ CST.case_clause = {pattern=PList (PNil rg);arrow=rg; rhs} in
     ok @@ [wrap cons_case; wrap nil_case]
   | Match_variant lst ->
-    let aux ((c,(v:AST.expression_variable)),e) = 
+    let aux ((c,(v:AST.expression_variable)),e) =
       let AST.Constructor c = c in
       let constr = wrap @@ c in
       let var : CST.pattern = PVar (decompile_variable v.wrap_content) in
@@ -630,9 +630,9 @@ let decompile_declaration : AST.declaration Location.wrap -> (CST.declaration, _
     ok @@ CST.TypeDecl (wrap (CST.{kwd_type; name; kwd_is; type_expr; terminator}))
   | Declaration_constant (var, ty_opt, inline, expr) ->
     let attributes = match inline with
-      true -> 
+      true ->
         let attr = wrap "inline" in
-        let ne_inj : _ CST.ne_injection = 
+        let ne_inj : _ CST.ne_injection =
           {kind=NEInjAttr rg;enclosing=End rg;ne_elements=(attr, []);terminator=Some rg} in
         let attr_decl = wrap ne_inj in
         Some attr_decl

src/passes/03-tree_abstraction/pascaligo/errors.ml

@@ -15,7 +15,7 @@ type abs_error = [
   | `Concrete_pascaligo_unsupported_string_singleton of Raw.type_expr
   | `Concrete_pascaligo_unsupported_deep_some_pattern of Raw.pattern
   | `Concrete_pascaligo_unsupported_deep_list_pattern of Raw.pattern
-  | `Concrete_pascaligo_unsupported_deep_tuple_pattern of (Raw.pattern, Raw.wild) Parser_shared.Utils.nsepseq Raw.par Raw.reg
+  | `Concrete_pascaligo_unsupported_deep_tuple_pattern of (Raw.pattern, Raw.wild) Simple_utils.Utils.nsepseq Raw.par Raw.reg
   | `Concrete_pascaligo_unknown_built_in of string
   | `Concrete_pascaligo_michelson_type_wrong of Raw.type_expr * string
   | `Concrete_pascaligo_michelson_type_wrong_arity of Location.t * string

src/stages/1-cst/cameligo/CST.ml

@@ -6,6 +6,7 @@
 
 (* Utilities *)
 
+module Utils = Simple_utils.Utils
 open Utils
 
 (* Regions
@@ -23,6 +24,10 @@ module Region = Simple_utils.Region
 
 type 'a reg = 'a Region.reg
 
+(* Lexemes *)
+
+type lexeme = string
+
 (* Keywords of OCaml *)
 
 type keyword   = Region.t
@@ -169,7 +174,7 @@ and type_expr =
 | TFun    of (type_expr * arrow * type_expr) reg
 | TPar    of type_expr par reg
 | TVar    of variable
-| TString of Lexer.lexeme reg
+| TString of lexeme reg
 
 and cartesian = (type_expr, times) nsepseq reg
 
@@ -192,9 +197,9 @@ and pattern =
 | PFalse    of kwd_false
 | PTrue     of kwd_true
 | PVar      of variable
-| PInt      of (Lexer.lexeme * Z.t) reg
+| PInt      of (lexeme * Z.t) reg
-| PNat      of (Lexer.lexeme * Z.t) reg
+| PNat      of (lexeme * Z.t) reg
-| PBytes    of (Lexer.lexeme * Hex.t) reg
+| PBytes    of (lexeme * Hex.t) reg
 | PString   of string reg
 | PVerbatim of string reg
 | PWild     of wild

src/stages/1-cst/cameligo/cameligo.ml

@@ -1 +0,0 @@
-include CST

src/stages/1-cst/cameligo/dune

@@ -2,12 +2,11 @@
   (name cst_cameligo)
   (public_name ligo.cst.cameligo)
   (libraries
+    ;; Ligo
     simple-utils
-    tezos-utils
+    ;; Third party
-    parser_shared
+    hex
-  )
+    zarith)
+  (modules CST ParserLog)
   (preprocess
-    (pps ppx_let bisect_ppx --conditional)
+    (pps ppx_let bisect_ppx --conditional)))
-  )
-  (flags (:standard -open Parser_shared -open Simple_utils ))
-)

src/stages/1-cst/dune

@@ -2,13 +2,7 @@
   (name cst)
   (public_name ligo.cst)
   (libraries
-    simple-utils
-    tezos-utils
     cst_cameligo
-    cst_pascaligo
+    cst_pascaligo)
-  )
   (preprocess
-    (pps ppx_let bisect_ppx --conditional)
+    (pps ppx_let bisect_ppx --conditional)))
-  )
-  (flags (:standard -open Simple_utils ))
-)

src/stages/1-cst/pascaligo/CST.ml

@@ -6,6 +6,7 @@
 
 (* Utilities *)
 
+module Utils = Simple_utils.Utils
 open Utils
 
 (* Regions
@@ -23,6 +24,10 @@ module Region = Simple_utils.Region
 
 type 'a reg = 'a Region.reg
 
+(* Lexemes *)
+
+type lexeme = string
+
 (* Keywords of LIGO *)
 
 type keyword        = Region.t
@@ -185,7 +190,7 @@ and type_expr =
 | TFun    of (type_expr * arrow * type_expr) reg
 | TPar    of type_expr par reg
 | TVar    of variable
-| TString of Lexer.lexeme reg
+| TString of lexeme reg
 
 and cartesian = (type_expr, times) nsepseq reg
 
@@ -227,7 +232,7 @@ and fun_decl = {
 and block_with = {
   block    : block reg;
   kwd_with : kwd_with;
-  expr     : expr;
+  expr     : expr
 }
 
 and parameters = (param_decl, semi) nsepseq par reg
@@ -460,15 +465,15 @@ and expr =
 | EProj    of projection reg
 | EUpdate  of update reg
 | EMap     of map_expr
-| EVar     of Lexer.lexeme reg
+| EVar     of lexeme reg
 | ECall    of fun_call
-| EBytes   of (Lexer.lexeme * Hex.t) reg
+| EBytes   of (lexeme * Hex.t) reg
 | EUnit    of c_Unit
 | ETuple   of tuple_expr
 | EPar     of expr par reg
 | EFun     of fun_expr reg
 | ECodeInj of code_inj reg
-| EBlock      of block_with reg
+| EBlock   of block_with reg
 
 and annot_expr = expr * colon * type_expr
 
@@ -527,14 +532,14 @@ and arith_expr =
 | Div   of slash   bin_op reg
 | Mod   of kwd_mod bin_op reg
 | Neg   of minus    un_op reg
-| Int   of (Lexer.lexeme * Z.t) reg
+| Int   of (lexeme * Z.t) reg
-| Nat   of (Lexer.lexeme * Z.t) reg
+| Nat   of (lexeme * Z.t) reg
-| Mutez of (Lexer.lexeme * Z.t) reg
+| Mutez of (lexeme * Z.t) reg
 
 and string_expr =
   Cat      of cat bin_op reg
-| String   of Lexer.lexeme reg
+| String   of lexeme reg
-| Verbatim of Lexer.lexeme reg
+| Verbatim of lexeme reg
 
 and list_expr =
   ECons     of cons bin_op reg
@@ -574,7 +579,7 @@ and field_path_assignment = {
 
 and selection =
   FieldName of field_name
-| Component of (Lexer.lexeme * Z.t) reg
+| Component of (lexeme * Z.t) reg
 
 and tuple_expr = (expr, comma) nsepseq par reg
 
@@ -618,12 +623,12 @@ and ne_injection_kwd =
 
 and pattern =
   PConstr of constr_pattern
-| PVar    of Lexer.lexeme reg
+| PVar    of lexeme reg
 | PWild   of wild
-| PInt    of (Lexer.lexeme * Z.t) reg
+| PInt    of (lexeme * Z.t) reg
-| PNat    of (Lexer.lexeme * Z.t) reg
+| PNat    of (lexeme * Z.t) reg
-| PBytes  of (Lexer.lexeme * Hex.t) reg
+| PBytes  of (lexeme * Hex.t) reg
-| PString of Lexer.lexeme reg
+| PString of lexeme reg
 | PList   of list_pattern
 | PTuple  of tuple_pattern
 

src/stages/1-cst/pascaligo/ParserLog.ml

@@ -64,7 +64,7 @@ let print_sepseq :
         None -> ()
   | Some seq -> print_nsepseq state sep print seq
 
-let print_option : state -> (state -> 'a -> unit ) -> 'a option -> unit =
+let print_option : state -> (state -> 'a -> unit) -> 'a option -> unit =
   fun state print -> function
     None -> ()
   | Some opt -> print state opt
@@ -141,7 +141,7 @@ and print_const_decl state {value; _} =
        equal; init; terminator; _} = value in
   print_token      state kwd_const "const";
   print_var        state name;
-  print_option     state print_colon_type_expr const_type;
+  print_option     state print_type_annot const_type;
   print_token      state equal "=";
   print_expr       state init;
   print_terminator state terminator
@@ -165,7 +165,7 @@ and print_type_expr state = function
 | TVar    type_var    -> print_var         state type_var
 | TString str         -> print_string      state str
 
-and print_colon_type_expr state (colon, type_expr) =
+and print_type_annot state (colon, type_expr) =
   print_token     state colon ":";
   print_type_expr state type_expr;
 
@@ -223,7 +223,7 @@ and print_fun_decl state {value; _} =
   print_token      state kwd_function "function";
   print_var        state fun_name;
   print_parameters state param;
-  print_option     state print_colon_type_expr  ret_type;
+  print_option     state print_type_annot ret_type;
   print_token      state kwd_is "is";
   print_expr state return;
   print_terminator state terminator;
@@ -233,7 +233,7 @@ and print_fun_expr state {value; _} =
        ret_type; kwd_is; return} : fun_expr = value in
   print_token      state kwd_function "function";
   print_parameters state param;
-  print_option     state print_colon_type_expr ret_type;
+  print_option     state print_type_annot ret_type;
   print_token      state kwd_is "is";
   print_expr       state return
 
@@ -255,9 +255,9 @@ and print_block_expr state {value; _} =
 
 and print_parameters state {value; _} =
   let {lpar; inside; rpar} = value in
-  print_token state lpar "(";
+  print_token   state lpar "(";
   print_nsepseq state ";" print_param_decl inside;
-  print_token state rpar ")"
+  print_token   state rpar ")"
 
 and print_param_decl state = function
   ParamConst param_const -> print_param_const state param_const
@@ -265,15 +265,15 @@ and print_param_decl state = function
 
 and print_param_const state {value; _} =
   let {kwd_const; var; param_type} = value in
-  print_token     state kwd_const "const";
+  print_token  state kwd_const "const";
-  print_var       state var;
+  print_var    state var;
-  print_option    state print_colon_type_expr param_type
+  print_option state print_type_annot param_type
 
 and print_param_var state {value; _} =
   let {kwd_var; var; param_type} = value in
   print_token    state kwd_var "var";
   print_var      state var;
-  print_option   state print_colon_type_expr param_type
+  print_option   state print_type_annot param_type
 
 and print_block state block =
   let {enclosing; statements; terminator} = block.value in
@@ -300,7 +300,7 @@ and print_var_decl state {value; _} =
        assign; init; terminator} = value in
   print_token      state kwd_var "var";
   print_var        state name;
-  print_option     state print_colon_type_expr var_type;
+  print_option     state print_type_annot var_type;
   print_token      state assign ":=";
   print_expr       state init;
   print_terminator state terminator
@@ -919,35 +919,49 @@ and pp_declaration state = function
 and pp_attr_decl state = pp_ne_injection pp_string state
 
 and pp_fun_decl state decl =
-  let arity, start =
+  let kwd_recursive = if decl.kwd_recursive = None then 0 else 1 in
+  let ret_type = if decl.ret_type = None then 0 else 1 in
+  let arity = kwd_recursive + ret_type + 3 in
+  let index = 0 in
+  let index =
     match decl.kwd_recursive with
-      None -> 4,0
+        None -> index
-    | Some _ ->
+    | Some _ -> let state = state#pad arity index in
-       let state = state#pad 5 0 in
+               pp_node state "recursive";
-       let () = pp_node state "recursive"
+               index + 1 in
-       in 5,1 in
+  let index =
-  let () =
+    let state = state#pad arity index in
-    let state = state#pad arity start in
+    pp_ident state decl.fun_name;
-    pp_ident state decl.fun_name in
+    index + 1 in
-  let () =
+  let index =
-    let state = state#pad arity (start + 1) in
+    let state = state#pad arity index in
     pp_node state "<parameters>";
-    pp_parameters state decl.param in
+    pp_parameters state decl.param;
+    index + 1 in
+  let index =
+    match decl.ret_type with
+      None -> index
+    | Some (_, t_expr) ->
+       let state = state#pad arity index in
+       pp_node state "<return type>";
+       pp_type_expr (state#pad 1 0) t_expr;
+       index+1 in
   let () =
-    let state = state#pad arity (start + 2) in
+    let state = state#pad arity index in
-    pp_node state "<return type>";
-    print_option (state#pad 1 0) pp_type_expr @@ Option.map snd decl.ret_type in
-  let () =
-    let state = state#pad arity (start + 3) in
     pp_node state "<return>";
     pp_expr (state#pad 1 0) decl.return
   in ()
 
 and pp_const_decl state decl =
-  let arity = 3 in
+  let arity = if decl.const_type = None then 2 else 3 in
-  pp_ident (state#pad arity 0) decl.name;
+  let index = 0 in
-  print_option (state#pad arity 1) pp_type_expr @@ Option.map snd decl.const_type;
+  let index =
-  pp_expr (state#pad arity 2) decl.init
+    pp_ident (state#pad arity 0) decl.name; index+1 in
+  let index =
+    pp_type_annot (state#pad arity index) index decl.const_type in
+  let () =
+    pp_expr (state#pad arity index) decl.init
+  in ()
 
 and pp_type_expr state = function
   TProd cartesian ->
@@ -1008,43 +1022,49 @@ and pp_type_tuple state {value; _} =
   in List.iteri (List.length components |> apply) components
 
 and pp_fun_expr state (expr: fun_expr) =
-  let () =
+  let arity = if expr.ret_type = None then 2 else 3 in
-    let state = state#pad 3 0 in
+  let index = 0 in
+  let index =
+    let state = state#pad arity index in
     pp_node state "<parameters>";
-    pp_parameters state expr.param in
+    pp_parameters state expr.param;
+    index + 1 in
+  let index =
+    match expr.ret_type with
+      None -> index
+    | Some (_, t_expr) ->
+        let state = state#pad arity index in
+        pp_node state "<return type>";
+        pp_type_expr (state#pad 1 0) t_expr;
+        index + 1 in
   let () =
-    let state = state#pad 3 1 in
+    let state = state#pad arity index in
-    pp_node state "<return type>";
-    print_option (state#pad 1 0) pp_type_expr @@ Option.map snd expr.ret_type in
-  let () =
-    let state = state#pad 3 2 in
     pp_node state "<return>";
     pp_expr (state#pad 1 0) expr.return
   in ()
 
-and pp_code_inj state rc =
+and pp_code_inj state node =
   let () =
     let state = state#pad 2 0 in
     pp_node state "<language>";
-    pp_string (state#pad 1 0) rc.language.value in
+    pp_string (state#pad 1 0) node.language.value in
   let () =
     let state = state#pad 2 1 in
     pp_node state "<code>";
-    pp_expr (state#pad 1 0) rc.code
+    pp_expr (state#pad 1 0) node.code
   in ()
 
-and pp_block_expr state (bw : block_with) =
+and pp_block_expr state node =
-  let {block;expr;_}:CST.block_with = bw in
+  let {block; expr; _} : block_with = node in
   let () =
     let state = state#pad 2 0 in
     pp_node state "<block>";
-    pp_statements state block.value.statements
+    pp_statements state block.value.statements in
-  in
   let () =
     let state = state#pad 2 1 in
     pp_node state "<expr>";
-    pp_expr (state#pad 1 0) expr in
+    pp_expr (state#pad 1 0) expr
-  ()
+  in ()
 
 and pp_parameters state {value; _} =
   let params = Utils.nsepseq_to_list value.inside in
@@ -1054,13 +1074,15 @@ and pp_parameters state {value; _} =
 
 and pp_param_decl state = function
   ParamConst {value; region} ->
+    let arity = if value.param_type = None then 1 else 2 in
     pp_loc_node state "ParamConst" region;
-    pp_ident (state#pad 2 0) value.var;
+    pp_ident (state#pad arity 0) value.var;
-    print_option (state#pad 2 1) pp_type_expr @@ Option.map snd value.param_type
+    ignore (pp_type_annot (state#pad arity 1) 1 value.param_type)
 | ParamVar {value; region} ->
+    let arity = if value.param_type = None then 1 else 2 in
     pp_loc_node state "ParamVar" region;
     pp_ident (state#pad 2 0) value.var;
-    print_option (state#pad 2 1) pp_type_expr @@ Option.map snd value.param_type
+    ignore (pp_type_annot (state#pad arity 1) 1 value.param_type)
 
 and pp_statements state statements =
   let statements = Utils.nsepseq_to_list statements in
@@ -1461,9 +1483,11 @@ and pp_data_decl state = function
     pp_fun_decl state value
 
 and pp_var_decl state decl =
-  pp_ident     (state#pad 3 0) decl.name;
+  let arity = if decl.var_type = None then 2 else 3 in
-  print_option (state#pad 3 1) pp_type_expr @@ Option.map snd decl.var_type;
+  let index = 0 in
-  pp_expr      (state#pad 3 2) decl.init
+  let index = pp_ident (state#pad arity index) decl.name; index+1 in
+  let index = pp_type_annot (state#pad arity index) index decl.var_type
+  in pp_expr (state#pad arity index) decl.init
 
 and pp_expr state = function
   ECase {value; region} ->
@@ -1663,3 +1687,7 @@ and pp_bin_op node region state op =
   pp_loc_node state node region;
   pp_expr     (state#pad 2 0) op.arg1;
   pp_expr     (state#pad 2 1) op.arg2
+
+and pp_type_annot state index = function
+  None -> index
+| Some (_, e) -> pp_type_expr state e; index+1

src/stages/1-cst/pascaligo/dune

@@ -2,12 +2,11 @@
   (name cst_pascaligo)
   (public_name ligo.cst.pascaligo)
   (libraries
+    ;; Ligo
     simple-utils
-    tezos-utils
+    ;; Third party
-    parser_shared
+    hex
-  )
+    zarith)
+  (modules CST ParserLog)
   (preprocess
-    (pps ppx_let bisect_ppx --conditional)
+    (pps ppx_let bisect_ppx --conditional)))
-  )
-  (flags (:standard -open Parser_shared -open Simple_utils ))
-)

src/stages/1-cst/pascaligo/pascaligo.ml

@@ -1 +0,0 @@
-include CST

vendors/Preprocessor/dune

@@ -5,11 +5,17 @@
   (public_name Preprocessor)
   (wrapped true)
   (libraries
-     getopt
+    getopt
-     simple-utils)
+    simple-utils)
-  (modules EvalOpt E_Parser E_Lexer E_AST Preproc)
+  (modules
+    EvalOpt
+    E_Parser
+    E_Lexer
+    E_AST
+    Preproc)
   (preprocess
-    (pps bisect_ppx --conditional)))
+    (pps bisect_ppx --conditional))
+  (flags (:standard -open Simple_utils)))
 
 ;; Building the lexers of the preprocessor
 

vendors/ligo-utils/simple-utils/dune

@@ -4,9 +4,6 @@
   (libraries
     yojson
     unix
-    str
+    str)
-  )
   (preprocess
-    (pps ppx_let)
+    (pps ppx_let)))
-  )
-)

vendors/ligo-utils/simple-utils/simple-utils.opam

@@ -3,20 +3,16 @@ name         : "simple-utils"
 version      : "dev"
 synopsis     : "LIGO utilities, to be used by other libraries"
 maintainer   : "Galfour <contact@ligolang.org>"
-authors      : "Galfour"
+authors      : "Galfour, Christian Rinderknecht"
 license      : "MIT"
-homepage: "https://gitlab.com/ligolang/ligo-utils"
+homepage     : "https://gitlab.com/ligolang/ligo-utils"
-bug-reports: "https://gitlab.com/ligolang/ligo-utils/issues"
+bug-reports  : "https://gitlab.com/ligolang/ligo-utils/issues"
-depends: [
+depends      : ["dune"
-  "dune"
+                "base"
-  "base"
+                "yojson"
-  "yojson"
+                "ppx_let"
-  "ppx_let"
+                # from ppx_let:
-  # from ppx_let:
+                "ocaml" {>= "4.04.2" & < "4.08.0"}
-  "ocaml" {>= "4.04.2" & < "4.08.0"}
+                "dune"   {build & >= "1.5.1"}
-  "dune"   {build & >= "1.5.1"}
+                "ppxlib" {>= "0.5.0"}]
-  "ppxlib" {>= "0.5.0"}
+build        : [["dune" "build" "-p" name]]
-]
-build: [
-  ["dune" "build" "-p" name]
-]

vendors/ligo-utils/simple-utils/simple_utils.ml

@@ -10,10 +10,14 @@ module Int = X_int
 module Tuple = Tuple
 module Map = X_map
 module Tree = Tree
-module Region = Region
-module Pos = Pos
 module Var = Var
 module Ligo_string = X_string
 module Display = Display
 module Runned_result = Runned_result
 
+(* Originally by Christian Rinderknecht *)
+
+module Pos    = Pos
+module Region = Region
+module Utils  = Utils
+module FQueue = FQueue