Merge branch 'rinderknecht@preproc' into 'dev'

Replacing CPP

See merge request ligolang/ligo!512

docker/distribution/debian/package.Dockerfile

@@ -12,14 +12,14 @@ RUN mkdir /package && mkdir /package/bin && mkdir /package/DEBIAN && mkdir /pack
 RUN cp /home/opam/.opam/4.07/bin/ligo /package/bin/ligo
 
 # @TODO: inherit version (and other details) from the ligo opam package definition
-# In our case we're using the version field to name our package accordingly, 
+# In our case we're using the version field to name our package accordingly,
 # however this is most likely not ideal
 # Also, the architecture field should not be 'all' but rather specific instead.
 RUN echo "Package: ligo\n\
 Version: $version\n\
 Architecture: all\n\
 Maintainer: info@ligolang.org\n\
-Depends: libev4, libgmp10, libgmpxx4ldbl, cpp\n\
+Depends: libev4, libgmp10, libgmpxx4ldbl\n\
 Homepage: http://ligolang.org\n\
 Description: LIGO is a statically typed high-level smart-contract language that compiles down to Michelson." >> /package/DEBIAN/control
 

gitlab-pages/docs/advanced/entrypoints-contracts.md

@@ -466,8 +466,8 @@ let proxy = ((action, store): (parameter, storage)) : return => {
     | Some (contract) => contract;
     | None => (failwith ("Contract not found.") : contract (parameter));
     };
-  (* Reuse the parameter in the subsequent
-     transaction or use another one, `mock_param`. *)
+  /* Reuse the parameter in the subsequent
+     transaction or use another one, `mock_param`. */
   let mock_param : parameter = Increment (5n);
   let op : operation = Tezos.transaction (action, 0tez, counter);
   ([op], store)

ligo.opam

@@ -1,6 +1,6 @@
 name: "ligo"
 opam-version: "2.0"
-maintainer: "ligolang@gmail.com"
+maintainer: "Galfour <contact@ligolang.org>"
 authors: [ "Galfour" ]
 homepage: "https://gitlab.com/ligolang/tezos"
 bug-reports: "https://gitlab.com/ligolang/tezos/issues"

src/bin/cli.ml

@@ -152,6 +152,18 @@ let compile_file =
   let doc = "Subcommand: Compile a contract." in
   (Term.ret term , Term.info ~doc cmdname)
 
+let preprocess =
+  let f source_file syntax display_format = (
+    toplevel ~display_format @@
+      let%bind pp =
+        Compile.Of_source.preprocess source_file (Syntax_name syntax) in
+      ok @@ Format.asprintf "%s \n" (Buffer.contents pp)
+  ) in
+  let term = Term.(const f $ source_file 0 $ syntax $ display_format) in
+  let cmdname = "preprocess" in
+  let doc = "Subcommand: Preprocess the source file.\nWarning: Intended for development of LIGO and can break at any time." in
+  (Term.ret term, Term.info ~doc cmdname)
+
 let print_cst =
   let f source_file syntax display_format = (
     toplevel ~display_format @@
@@ -470,4 +482,5 @@ let run ?argv () =
     print_ast_typed ;
     print_mini_c ;
     list_declarations ;
+    preprocess
   ]

src/bin/expect_tests/error_messages_tests.ml

@@ -3,7 +3,7 @@ open Cli_expect
 let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/gitlab_111.religo" ; "main" ] ;
   [%expect {|
-    ligo: : Parse error in file "gitlab_111.religo", line 2, characters 0-3, after "=" and before "let":
+    ligo: : Parse error in file "gitlab_111.religo", line 2, characters 0-3 at "let", after "=":
           This is an incorrect let binding. 
           -
           Examples of correct let bindings: 
@@ -23,7 +23,7 @@ let%expect_test _ =
 
   run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/missing_rpar.religo" ; "main" ] ;
   [%expect {|
-    ligo: : Parse error in file "missing_rpar.religo", line 5, characters 0-3, after "m" and before "let":
+    ligo: : Parse error in file "missing_rpar.religo", line 5, characters 0-3 at "let", after "m":
           Missing `)`.
            {}
 

src/bin/expect_tests/help_tests.ml

@@ -53,6 +53,10 @@ let%expect_test _ =
            measure-contract
                Subcommand: Measure a contract's compiled size in bytes.
 
+           preprocess
+               Subcommand: Preprocess the source file. Warning: Intended for
+               development of LIGO and can break at any time.
+
            print-ast
                Subcommand: Print the AST. Warning: Intended for development of
                LIGO and can break at any time.
@@ -140,6 +144,10 @@ let%expect_test _ =
            measure-contract
                Subcommand: Measure a contract's compiled size in bytes.
 
+           preprocess
+               Subcommand: Preprocess the source file. Warning: Intended for
+               development of LIGO and can break at any time.
+
            print-ast
                Subcommand: Print the AST. Warning: Intended for development of
                LIGO and can break at any time.

src/bin/expect_tests/syntax_error_tests.ml

@@ -3,7 +3,7 @@ open Cli_expect
 let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_syntax.ligo" ; "main" ] ;
   [%expect {|
-    ligo: : Parse error in file "error_syntax.ligo", line 1, characters 16-17, after "bar" and before "-":
+    ligo: : Parse error in file "error_syntax.ligo", line 1, characters 16-17 at "-", after "bar":
           15: <syntax error> {}
 
 

src/dune

@@ -1,14 +1,13 @@
-(dirs (:standard \ toto))
+(dirs (:standard))
+
 (library
   (name ligo)
   (public_name ligo)
   (libraries
-    simple-utils
-    tezos-utils
-    tezos-micheline
-    main
-  )
+     Preprocessor
+     simple-utils
+     tezos-utils
+     tezos-micheline
+     main)
   (preprocess
-    (pps ppx_let bisect_ppx --conditional)
-  )
-)
+    (pps ppx_let bisect_ppx --conditional)))

src/main/compile/helpers.ml

@@ -148,18 +148,18 @@ let pretty_print_cameligo source =
       ~offsets:true
       ~mode:`Point
       ~buffer in
-  Parser.Cameligo.ParserLog.pp_ast state ast;
+  Parser_cameligo.ParserLog.pp_ast state ast;
   ok buffer
 
 let pretty_print_reasonligo source =
   let%bind ast = Parser.Reasonligo.parse_file source in
   let buffer = Buffer.create 59 in
   let state = (* TODO: Should flow from the CLI *)
-    Parser.Reasonligo.ParserLog.mk_state
+    Parser_cameligo.ParserLog.mk_state
       ~offsets:true
       ~mode:`Point
       ~buffer in
-  Parser.Reasonligo.ParserLog.pp_ast state ast;
+  Parser_cameligo.ParserLog.pp_ast state ast;
   ok buffer
 
 let pretty_print syntax source =
@@ -169,3 +169,17 @@ let pretty_print syntax source =
     PascaLIGO  -> pretty_print_pascaligo  source
   | CameLIGO   -> pretty_print_cameligo   source
   | ReasonLIGO -> pretty_print_reasonligo source
+
+let preprocess_pascaligo = Parser.Pascaligo.preprocess
+
+let preprocess_cameligo = Parser.Cameligo.preprocess
+
+let preprocess_reasonligo = Parser.Reasonligo.preprocess
+
+let preprocess syntax source =
+  let%bind v_syntax =
+    syntax_to_variant syntax (Some source) in
+  match v_syntax with
+    PascaLIGO  -> preprocess_pascaligo  source
+  | CameLIGO   -> preprocess_cameligo   source
+  | ReasonLIGO -> preprocess_reasonligo source

src/main/compile/of_source.ml

@@ -19,5 +19,8 @@ let compile_contract_input : string -> string -> v_syntax -> Ast_imperative.expr
   let%bind (storage,parameter) = bind_map_pair (compile_expression syntax) (storage,parameter) in
   ok @@ Ast_imperative.e_pair storage parameter
 
-let pretty_print source_filename syntax = 
-  Helpers.pretty_print syntax source_filename 
+let pretty_print source_filename syntax =
+  Helpers.pretty_print syntax source_filename
+
+let preprocess source_filename syntax =
+  Helpers.preprocess syntax source_filename

src/passes/1-parser/cameligo.ml

@@ -4,26 +4,46 @@ module Lexer    = Lexer.Make(LexToken)
 module Scoping  = Parser_cameligo.Scoping
 module Region   = Simple_utils.Region
 module ParErr   = Parser_cameligo.ParErr
-module SSet     = Utils.String.Set
+module SSet     = Set.Make (String)
 
 (* Mock IOs TODO: Fill them with CLI options *)
 
-module type IO =
-  sig
-    val ext : string
-    val options : EvalOpt.options
-  end
+type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO]
 
-module PreIO =
+module SubIO =
   struct
-    let ext = ".ligo"
-    let pre_options =
-      EvalOpt.make ~libs:[]
-                   ~verbose:SSet.empty
-                   ~offsets:true
-                   ~mode:`Point
-                   ~cmd:EvalOpt.Quiet
-                   ~mono:false
+    type options = <
+      libs    : string list;
+      verbose : SSet.t;
+      offsets : bool;
+      lang    : language;
+      ext     : string;   (* ".mligo" *)
+      mode    : [`Byte | `Point];
+      cmd     : EvalOpt.command;
+      mono    : bool
+    >
+
+    let options : options =
+      object
+        method libs    = []
+        method verbose = SSet.empty
+        method offsets = true
+        method lang    = `CameLIGO
+        method ext     = ".mligo"
+        method mode    = `Point
+        method cmd     = EvalOpt.Quiet
+        method mono    = false
+      end
+
+    let make =
+      EvalOpt.make ~libs:options#libs
+                   ~verbose:options#verbose
+                   ~offsets:options#offsets
+                   ~lang:options#lang
+                   ~ext:options#ext
+                   ~mode:options#mode
+                   ~cmd:options#cmd
+                   ~mono:options#mono
   end
 
 module Parser =
@@ -40,34 +60,33 @@ module ParserLog =
     include Parser_cameligo.ParserLog
   end
 
-module PreUnit =
-  ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)
+module Unit =
+  ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO)
 
 module Errors =
   struct
-    (* let data =
-         [("location",
-           fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)] *)
-
     let generic message =
       let title () = ""
       and message () = message.Region.value
       in Trace.error ~data:[] title message
   end
 
-let parse (module IO : IO) parser =
-  let module Unit = PreUnit (IO) in
+let apply parser =
   let local_fail error =
     Trace.fail
     @@ Errors.generic
-    @@ Unit.format_error ~offsets:IO.options#offsets
-                        IO.options#mode error in
+    @@ Unit.format_error ~offsets:SubIO.options#offsets
+                        SubIO.options#mode error in
   match parser () with
     Stdlib.Ok semantic_value -> Trace.ok semantic_value
 
   (* Lexing and parsing errors *)
 
   | Stdlib.Error error -> Trace.fail @@ Errors.generic error
+  (* System errors *)
+
+  | exception Sys_error msg ->
+      Trace.fail @@ Errors.generic (Region.wrap_ghost msg)
   (* Scoping errors *)
 
   | exception Scoping.Error (Scoping.Reserved_name name) ->
@@ -110,71 +129,18 @@ let parse (module IO : IO) parser =
                Hint: Change the name.\n",
               None, invalid))
 
-let parse_file (source: string) =
-  let module IO =
-    struct
-      let ext = PreIO.ext
-      let options =
-        PreIO.pre_options ~input:(Some source) ~expr:false
-    end in
-  let lib_path =
-    match IO.options#libs with
-      [] -> ""
-    | libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path
-             in List.fold_right mk_I libs "" in
-  let prefix =
-    match IO.options#input with
-      None | Some "-" -> "temp"
-    | Some file -> Filename.(remove_extension @@ basename file) in
-  let suffix = ".pp" ^ IO.ext in
-  let pp_input =
-    if   SSet.mem "cpp" IO.options#verbose
-    then prefix ^ suffix
-    else let pp_input, pp_out =
-           Filename.open_temp_file prefix suffix
-         in close_out pp_out; pp_input in
-  let cpp_cmd =
-    match IO.options#input with
-      None | Some "-" ->
-        Printf.sprintf "cpp -traditional-cpp%s - > %s"
-                       lib_path pp_input
-    | Some file ->
-        Printf.sprintf "cpp -traditional-cpp%s %s > %s"
-                       lib_path file pp_input in
-  let open Trace in
-  let%bind () = sys_command cpp_cmd in
-  let module Unit = PreUnit (IO) in
-  match Lexer.(open_token_stream @@ File pp_input) with
-    Ok instance ->
-      let thunk () = Unit.apply instance Unit.parse_contract
-      in parse (module IO) thunk
-  | Stdlib.Error (Lexer.File_opening msg) ->
-      Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg
+(* Parsing a contract in a file *)
 
-let parse_string (s: string) =
-  let module IO =
-    struct
-      let ext = PreIO.ext
-      let options = PreIO.pre_options ~input:None ~expr:false
-    end in
-  let module Unit = PreUnit (IO) in
-  match Lexer.(open_token_stream @@ String s) with
-    Ok instance ->
-      let thunk () = Unit.apply instance Unit.parse_contract
-      in parse (module IO) thunk
-  | Stdlib.Error (Lexer.File_opening msg) ->
-      Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg
+let parse_file source = apply (fun () -> Unit.contract_in_file source)
 
-let parse_expression (s: string)  =
-  let module IO =
-    struct
-      let ext = PreIO.ext
-      let options = PreIO.pre_options ~input:None ~expr:true
-    end in
-  let module Unit = PreUnit (IO) in
-  match Lexer.(open_token_stream @@ String s) with
-    Ok instance ->
-      let thunk () = Unit.apply instance Unit.parse_expr
-      in parse (module IO) thunk
-  | Stdlib.Error (Lexer.File_opening msg) ->
-      Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg
+(* Parsing a contract in a string *)
+
+let parse_string source = apply (fun () -> Unit.contract_in_string source)
+
+(* Parsing an expression in a string *)
+
+let parse_expression source = apply (fun () -> Unit.expr_in_string source)
+
+(* Preprocessing a contract in a file *)
+
+let preprocess source = apply (fun () -> Unit.preprocess source)

src/passes/1-parser/cameligo.mli

@@ -0,0 +1,21 @@
+(** This file provides an interface to the CameLIGO parser. *)
+
+module AST = Parser_cameligo.AST
+
+(** Open a CameLIGO filename given by string and convert into an
+    abstract syntax tree. *)
+val parse_file : string -> AST.t Trace.result
+
+(** Convert a given string into a CameLIGO abstract syntax tree *)
+val parse_string : string -> AST.t Trace.result
+
+(** Parse a given string as a CameLIGO expression and return an
+    expression AST.
+
+    This is intended to be used for interactive interpreters, or other
+    scenarios where you would want to parse a CameLIGO expression
+    outside of a contract. *)
+val parse_expression : string -> AST.expr Trace.result
+
+(** Preprocess a given CameLIGO file and preprocess it. *)
+val preprocess : string -> Buffer.t Trace.result

src/passes/1-parser/cameligo/.links

@@ -1,8 +1,5 @@
 $HOME/git/OCaml-build/Makefile
-$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli
-$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml
-$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli
-$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
+
 ../shared/Lexer.mli
 ../shared/Lexer.mll
 ../shared/EvalOpt.ml
@@ -17,7 +14,9 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
 ../shared/Utils.ml
 ../shared/ParserAPI.mli
 ../shared/ParserAPI.ml
+../shared/LexerUnit.mli
 ../shared/LexerUnit.ml
+../shared/ParserUnit.mli
 ../shared/ParserUnit.ml
-Stubs/Simple_utils.ml
+
 $HOME/git/ligo/_build/default/src/passes/1-parser/cameligo/ParErr.ml

src/passes/1-parser/cameligo/AST.ml

@@ -19,6 +19,8 @@ open Utils
    denoting the _region_ of the occurrence of the keyword "and".
 *)
 
+module Region = Simple_utils.Region
+
 type 'a reg = 'a Region.reg
 
 (* Keywords of OCaml *)

src/passes/1-parser/cameligo/LexerMain.ml

@@ -4,8 +4,7 @@ module Region = Simple_utils.Region
 
 module IO =
   struct
-    let ext = ".mligo"
-    let options = EvalOpt.read "CameLIGO" ext
+    let options = EvalOpt.(read ~lang:`CameLIGO ~ext:".mligo")
   end
 
 module M = LexerUnit.Make (IO) (Lexer.Make (LexToken))

src/passes/1-parser/cameligo/Makefile.cfg

@@ -2,4 +2,4 @@ SHELL := dash
 BFLAGS := -strict-sequence -w +A-48-4 -g
 
 clean::
-> rm -f Parser.msg Parser.msg.map Parser.msg.states Version.ml
+> \rm -f Parser.msg Parser.msg.map Parser.msg.states Version.ml

src/passes/1-parser/cameligo/Parser.mly

@@ -3,7 +3,7 @@
 
 [@@@warning "-42"]
 
-open Region
+open Simple_utils.Region
 open AST
 
 (* END HEADER *)

src/passes/1-parser/cameligo/ParserLog.ml

@@ -2,6 +2,7 @@
 [@@@coverage exclude_file]
 
 open AST
+module Region = Simple_utils.Region
 open! Region
 
 let sprintf = Printf.sprintf
@@ -866,7 +867,7 @@ and pp_let_in state node =
   let fields = if lhs_type = None then 3 else 4 in
   let fields = if kwd_rec = None then fields else fields+1 in
   let fields = if attributes = [] then fields else fields+1 in
-  let arity = 
+  let arity =
     match kwd_rec with
       None -> 0
     | Some (_) ->

src/passes/1-parser/cameligo/ParserMain.ml

@@ -1,9 +1,47 @@
-(** Driver for the CameLIGO parser *)
+(* Driver for the CameLIGO parser *)
+
+module Region = Simple_utils.Region
+module SSet   = Set.Make (String)
 
 module IO =
   struct
-    let ext = ".mligo"
-    let options = EvalOpt.read "CameLIGO" ext
+    let options = EvalOpt.(read ~lang:`CameLIGO ~ext:".mligo")
+  end
+
+module SubIO =
+  struct
+    type options = <
+      libs    : string list;
+      verbose : SSet.t;
+      offsets : bool;
+      lang    : EvalOpt.language;
+      ext     : string;
+      mode    : [`Byte | `Point];
+      cmd     : EvalOpt.command;
+      mono    : bool
+    >
+
+    let options : options =
+      object
+        method libs    = IO.options#libs
+        method verbose = IO.options#verbose
+        method offsets = IO.options#offsets
+        method lang    = IO.options#lang
+        method ext     = IO.options#ext
+        method mode    = IO.options#mode
+        method cmd     = IO.options#cmd
+        method mono    = IO.options#mono
+      end
+
+    let make =
+      EvalOpt.make ~libs:options#libs
+                   ~verbose:options#verbose
+                   ~offsets:options#offsets
+                   ~lang:options#lang
+                   ~ext:options#ext
+                   ~mode:options#mode
+                   ~cmd:options#cmd
+                   ~mono:options#mono
   end
 
 module Parser =
@@ -23,118 +61,16 @@ module ParserLog =
 module Lexer = Lexer.Make (LexToken)
 
 module Unit =
-  ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(IO)
+  ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO)
 
 (* Main *)
 
-let issue_error error : ('a, string Region.reg) Stdlib.result =
-  Stdlib.Error (Unit.format_error ~offsets:IO.options#offsets
-                                  IO.options#mode error)
-
-let parse parser : ('a, string Region.reg) Stdlib.result =
-  try parser () with
-    (* Scoping errors *)
-
-  | Scoping.Error (Scoping.Reserved_name name) ->
-      let token =
-        Lexer.Token.mk_ident name.Region.value name.Region.region in
-      (match token with
-         (* Cannot fail because [name] is a not a
-            reserved name for the lexer. *)
-         Stdlib.Error _ -> assert false
-       | Ok invalid ->
-          issue_error
-            ("Reserved name.\nHint: Change the name.\n", None, invalid))
-
-  | Scoping.Error (Scoping.Duplicate_variant name) ->
-      let token =
-        Lexer.Token.mk_constr name.Region.value name.Region.region in
-      let point = "Duplicate constructor in this sum type declaration.\n\
-                   Hint: Change the constructor.\n",
-                  None, token
-      in issue_error point
-
-  | Scoping.Error (Scoping.Non_linear_pattern var) ->
-      let token =
-        Lexer.Token.mk_ident var.Region.value var.Region.region in
-      (match token with
-         (* Cannot fail because [var] is a not a
-            reserved name for the lexer. *)
-         Stdlib.Error _ -> assert false
-       | Ok invalid ->
-           let point = "Repeated variable in this pattern.\n\
-                        Hint: Change the name.\n",
-                       None, invalid
-           in issue_error point)
-
-  | Scoping.Error (Scoping.Duplicate_field name) ->
-      let token =
-        Lexer.Token.mk_ident name.Region.value name.Region.region in
-      (match token with
-         (* Cannot fail because [name] is a not a
-            reserved name for the lexer. *)
-         Stdlib.Error _ -> assert false
-       | Ok invalid ->
-           let point = "Duplicate field name in this record declaration.\n\
-                        Hint: Change the name.\n",
-                       None, invalid
-           in issue_error point)
-
-(* Preprocessing the input source with CPP *)
-
-module SSet = Utils.String.Set
-let sprintf = Printf.sprintf
-
-(* Path for CPP inclusions (#include) *)
-
-let lib_path =
-  match IO.options#libs with
-    [] -> ""
-  | libs -> let mk_I dir path = sprintf " -I %s%s" dir path
-           in List.fold_right mk_I libs ""
-
-let prefix =
-  match IO.options#input with
-    None | Some "-" -> "temp"
-  | Some file -> Filename.(file |> basename |> remove_extension)
-
-let suffix = ".pp" ^ IO.ext
-
-let pp_input =
-  if SSet.mem "cpp" IO.options#verbose
-  then prefix ^ suffix
-  else let pp_input, pp_out =
-         Filename.open_temp_file prefix suffix
-       in close_out pp_out; pp_input
-
-let cpp_cmd =
-  match IO.options#input with
-    None | Some "-" ->
-      sprintf "cpp -traditional-cpp%s - > %s"
-              lib_path pp_input
-  | Some file ->
-      sprintf "cpp -traditional-cpp%s %s > %s"
-              lib_path file pp_input
+let wrap = function
+  Stdlib.Ok _ -> flush_all ()
+| Error msg ->
+    (flush_all (); Printf.eprintf "\027[31m%s\027[0m%!" msg.Region.value)
 
 let () =
-  if Sys.command cpp_cmd <> 0 then
-    Printf.eprintf "External error: \"%s\" failed." cpp_cmd
-
-(* Instantiating the lexer and calling the parser *)
-
-let lexer_inst =
-  match Lexer.open_token_stream (Lexer.File pp_input) with
-    Ok instance ->
-      if IO.options#expr
-      then
-        match parse (fun () -> Unit.apply instance Unit.parse_expr) with
-          Stdlib.Ok _ -> ()
-        | Error Region.{value; _} ->
-           Printf.eprintf "\027[31m%s\027[0m%!" value
-      else
-        (match parse (fun () -> Unit.apply instance Unit.parse_contract) with
-          Stdlib.Ok _ -> ()
-        | Error Region.{value; _} ->
-           Printf.eprintf "\027[31m%s\027[0m%!" value)
-  | Stdlib.Error (Lexer.File_opening msg) ->
-      Printf.eprintf "\027[31m%s\027[0m%!" msg
+  match IO.options#input with
+    None -> Unit.contract_in_stdin () |> wrap
+  | Some file_path -> Unit.contract_in_file file_path |> wrap

src/passes/1-parser/cameligo/Scoping.ml

@@ -1,5 +1,6 @@
 [@@@warning "-42"]
 
+module Region = Simple_utils.Region
 
 type t =
   Reserved_name      of AST.variable

src/passes/1-parser/cameligo/Scoping.mli

@@ -1,5 +1,7 @@
 (* This module exports checks on scoping, called from the parser. *)
 
+module Region = Simple_utils.Region
+
 type t =
   Reserved_name       of AST.variable
 | Duplicate_variant   of AST.variable

src/passes/1-parser/cameligo/Stubs/Simple_utils.ml

@@ -1,2 +0,0 @@
-module Region = Region
-module Pos = Pos

src/passes/1-parser/cameligo/dune

@@ -77,8 +77,8 @@
 ;  (targets error.messages)
 ;  (deps Parser.mly ParToken.mly error.messages.checked-in)
 ;  (action
-;   (with-stdout-to %{targets} 
-;   (bash 
+;   (with-stdout-to %{targets}
+;   (bash
 ;     "menhir \
 ;       --unused-tokens \
 ;       --list-errors  \
@@ -97,11 +97,11 @@
  (targets error.messages)
  (deps Parser.mly ParToken.mly error.messages.checked-in LexToken.mli)
  (action
-  (with-stdout-to %{targets} 
-  (run 
+  (with-stdout-to %{targets}
+  (run
     menhir
       --unused-tokens
-      --update-errors error.messages.checked-in 
+      --update-errors error.messages.checked-in
       --table
       --strict
       --external-tokens LexToken.mli
@@ -115,8 +115,8 @@
 (rule
   (target error.messages.new)
   (action
-    (with-stdout-to %{target} 
-      (run 
+    (with-stdout-to %{target}
+      (run
         menhir
           --unused-tokens
           --list-errors
@@ -135,7 +135,7 @@
   (name runtest)
   (deps error.messages error.messages.new)
   (action
-    (run 
+    (run
       menhir
         --unused-tokens
         --table
@@ -156,8 +156,8 @@
  (targets ParErr.ml)
  (deps Parser.mly ParToken.mly error.messages.checked-in LexToken.mli)
  (action
-  (with-stdout-to %{targets} 
-  (run 
+  (with-stdout-to %{targets}
+  (run
     menhir
       --unused-tokens
       --table

src/passes/1-parser/pascaligo.ml

@@ -4,26 +4,46 @@ module Lexer    = Lexer.Make(LexToken)
 module Scoping  = Parser_pascaligo.Scoping
 module Region   = Simple_utils.Region
 module ParErr   = Parser_pascaligo.ParErr
-module SSet     = Utils.String.Set
+module SSet     = Set.Make (String)
 
 (* Mock IOs TODO: Fill them with CLI options *)
 
-module type IO =
-  sig
-    val ext : string
-    val options : EvalOpt.options
-  end
+type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO]
 
-module PreIO =
+module SubIO =
   struct
-    let ext = ".ligo"
-    let pre_options =
-      EvalOpt.make ~libs:[]
-                   ~verbose:SSet.empty
-                   ~offsets:true
-                   ~mode:`Point
-                   ~cmd:EvalOpt.Quiet
-                   ~mono:false
+    type options = <
+      libs    : string list;
+      verbose : SSet.t;
+      offsets : bool;
+      lang    : language;
+      ext     : string;   (* ".ligo" *)
+      mode    : [`Byte | `Point];
+      cmd     : EvalOpt.command;
+      mono    : bool
+    >
+
+    let options : options =
+      object
+        method libs    = []
+        method verbose = SSet.empty
+        method offsets = true
+        method lang    = `PascaLIGO
+        method ext     = ".ligo"
+        method mode    = `Point
+        method cmd     = EvalOpt.Quiet
+        method mono    = false
+      end
+
+    let make =
+      EvalOpt.make ~libs:options#libs
+                   ~verbose:options#verbose
+                   ~offsets:options#offsets
+                   ~lang:options#lang
+                   ~ext:options#ext
+                   ~mode:options#mode
+                   ~cmd:options#cmd
+                   ~mono:options#mono
   end
 
 module Parser =
@@ -40,34 +60,34 @@ module ParserLog =
     include Parser_pascaligo.ParserLog
   end
 
-module PreUnit =
-  ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)
+module Unit =
+  ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO)
 
 module Errors =
   struct
-    (* let data =
-         [("location",
-           fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)] *)
-
     let generic message =
       let title () = ""
       and message () = message.Region.value
       in Trace.error ~data:[] title message
   end
 
-let parse (module IO : IO) parser =
-  let module Unit = PreUnit (IO) in
+let apply parser =
   let local_fail error =
     Trace.fail
     @@ Errors.generic
-    @@ Unit.format_error ~offsets:IO.options#offsets
-                        IO.options#mode error in
+    @@ Unit.format_error ~offsets:SubIO.options#offsets
+                        SubIO.options#mode error in
   match parser () with
     Stdlib.Ok semantic_value -> Trace.ok semantic_value
 
   (* Lexing and parsing errors *)
 
   | Stdlib.Error error -> Trace.fail @@ Errors.generic error
+
+  (* System errors *)
+
+  | exception Sys_error msg ->
+      Trace.fail @@ Errors.generic (Region.wrap_ghost msg)
   (* Scoping errors *)
 
   | exception Scoping.Error (Scoping.Reserved_name name) ->
@@ -121,71 +141,18 @@ let parse (module IO : IO) parser =
                Hint: Change the name.\n",
               None, invalid))
 
-let parse_file source =
-  let module IO =
-    struct
-      let ext = PreIO.ext
-      let options =
-        PreIO.pre_options ~input:(Some source) ~expr:false
-    end in
-  let module Unit = PreUnit (IO) in
-  let lib_path =
-    match IO.options#libs with
-        [] -> ""
-    | libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path
-             in List.fold_right mk_I libs "" in
-  let prefix =
-    match IO.options#input with
-      None | Some "-" -> "temp"
-    | Some file -> Filename.(remove_extension @@ basename file) in
-  let suffix = ".pp" ^ IO.ext in
-  let pp_input =
-    if   SSet.mem "cpp" IO.options#verbose
-    then prefix ^ suffix
-    else let pp_input, pp_out =
-           Filename.open_temp_file prefix suffix
-         in close_out pp_out; pp_input in
-  let cpp_cmd =
-    match IO.options#input with
-      None | Some "-" ->
-        Printf.sprintf "cpp -traditional-cpp%s - > %s"
-                       lib_path pp_input
-    | Some file ->
-        Printf.sprintf "cpp -traditional-cpp%s %s > %s"
-                       lib_path file pp_input in
-  let open Trace in
-  let%bind () = sys_command cpp_cmd in
-  match Lexer.(open_token_stream @@ File pp_input) with
-    Ok instance ->
-      let thunk () = Unit.apply instance Unit.parse_contract
-      in parse (module IO) thunk
-  | Stdlib.Error (Lexer.File_opening msg) ->
-      Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg
+(* Parsing a contract in a file *)
 
-let parse_string (s: string) =
-  let module IO =
-    struct
-      let ext = PreIO.ext
-      let options = PreIO.pre_options ~input:None ~expr:false
-    end in
-  let module Unit = PreUnit (IO) in
-  match Lexer.(open_token_stream @@ String s) with
-    Ok instance ->
-      let thunk () = Unit.apply instance Unit.parse_contract
-      in parse (module IO) thunk
-  | Stdlib.Error (Lexer.File_opening msg) ->
-      Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg
+let parse_file source = apply (fun () -> Unit.contract_in_file source)
 
-let parse_expression (s: string) =
-  let module IO =
-    struct
-      let ext = PreIO.ext
-      let options = PreIO.pre_options ~input:None ~expr:true
-    end in
-  let module Unit = PreUnit (IO) in
-  match Lexer.(open_token_stream @@ String s) with
-    Ok instance ->
-      let thunk () = Unit.apply instance Unit.parse_expr
-      in parse (module IO) thunk
-  | Stdlib.Error (Lexer.File_opening msg) ->
-      Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg
+(* Parsing a contract in a string *)
+
+let parse_string source = apply (fun () -> Unit.contract_in_string source)
+
+(* Parsing an expression in a string *)
+
+let parse_expression source = apply (fun () -> Unit.expr_in_string source)
+
+(* Preprocessing a contract in a file *)
+
+let preprocess source = apply (fun () -> Unit.preprocess source)

src/passes/1-parser/pascaligo.mli

@@ -16,3 +16,6 @@ val parse_string : string -> AST.t Trace.result
     scenarios where you would want to parse a PascaLIGO expression
     outside of a contract. *)
 val parse_expression : string -> AST.expr Trace.result
+
+(** Preprocess a given PascaLIGO file and preprocess it. *)
+val preprocess : string -> Buffer.t Trace.result

src/passes/1-parser/pascaligo/.links

@@ -1,8 +1,5 @@
 $HOME/git/OCaml-build/Makefile
-$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli
-$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml
-$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli
-$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
+
 ../shared/Lexer.mli
 ../shared/Lexer.mll
 ../shared/EvalOpt.ml
@@ -21,7 +18,5 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
 ../shared/LexerUnit.ml
 ../shared/ParserUnit.mli
 ../shared/ParserUnit.ml
-../shared/Memo.mli
-../shared/Memo.ml
-Stubs/Simple_utils.ml
-$HOME/git/ligo/_build/default/src/passes/1-parser/pascaligo/ParErr.ml
+
+$HOME/git/ligo/_build/default/src/passes/1-parser/pascaligo/ParErr.ml

src/passes/1-parser/pascaligo/AST.ml

@@ -19,6 +19,8 @@ open Utils
    denoting the _region_ of the occurrence of the keyword "and".
 *)
 
+module Region = Simple_utils.Region
+
 type 'a reg = 'a Region.reg
 
 (* Keywords of LIGO *)

src/passes/1-parser/pascaligo/LexToken.mll

@@ -11,8 +11,8 @@ let sprintf = Printf.sprintf
 
 module Region = Simple_utils.Region
 module Pos    = Simple_utils.Pos
-module SMap   = Utils.String.Map
-module SSet   = Utils.String.Set
+module SMap   = Map.Make (String)
+module SSet   = Set.Make (String)
 
 (* Hack to roll back one lexeme in the current semantic action *)
 (*

src/passes/1-parser/pascaligo/LexerMain.ml

@@ -4,8 +4,7 @@ module Region = Simple_utils.Region
 
 module IO =
   struct
-    let ext = ".ligo"
-    let options = EvalOpt.read "PascaLIGO" ext
+    let options = EvalOpt.(read ~lang:`PascaLIGO ~ext:".ligo")
   end
 
 module M = LexerUnit.Make (IO) (Lexer.Make (LexToken))
@@ -13,4 +12,4 @@ module M = LexerUnit.Make (IO) (Lexer.Make (LexToken))
 let () =
   match M.trace () with
     Stdlib.Ok () -> ()
-  | Error Region.{value; _} -> Utils.highlight value
+  | Error Region.{value; _} -> Printf.eprintf "\027[31m%s\027[0m%!" value

src/passes/1-parser/pascaligo/Makefile.cfg

@@ -2,4 +2,4 @@ SHELL := dash
 BFLAGS := -strict-sequence -w +A-48-4 -g
 
 clean::
-> rm -f Parser.msg Parser.msg.map Parser.msg.states Version.ml
+> \rm -f Parser.msg Parser.msg.map Parser.msg.states Version.ml

src/passes/1-parser/pascaligo/Misc/pascaligo.ml

@@ -1,39 +0,0 @@
-
-module ParserLog = Parser_pascaligo.ParserLog
-module ParErr = Parser_pascaligo.ParErr
-module SSet = Utils.String.Set
-
-(* Mock options. TODO: Plug in cmdliner. *)
-
-let pre_options =
-  EvalOpt.make
-    ~libs:[]
-    ~verbose:SSet.empty
-    ~offsets:true
-    ~mode:`Point
-    ~cmd:EvalOpt.Quiet
-    ~mono:true (* Monolithic API of Menhir for now *)
-(*  ~input:None *)
-(*  ~expr:true  *)
-
-module Parser =
-  struct
-    type ast  = AST.t
-    type expr = AST.expr
-    include Parser_pascaligo.Parser
-  end
-
-module ParserLog =
-  struct
-    type ast  = AST.t
-    type expr = AST.expr
-    include Parser_pascaligo.ParserLog
-  end
-
-module PreUnit = ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)
-module Front   = ParserAPI.Make (Lexer)(Parser)(ParErr)
-
-let issue_error point =
-  let error = Front.format_error ~offsets:true (* TODO: CLI *)
-                                 `Point (* TODO: CLI *) point
-  in Stdlib.Error error

src/passes/1-parser/pascaligo/Parser.mly

@@ -3,7 +3,7 @@
 
 [@@@warning "-42"]
 
-open Region
+open Simple_utils.Region
 open AST
 
 (* END HEADER *)

src/passes/1-parser/pascaligo/ParserLog.ml

@@ -2,6 +2,8 @@
 [@@@coverage exclude_file]
 
 open AST
+
+module Region = Simple_utils.Region
 open! Region
 
 let sprintf = Printf.sprintf

src/passes/1-parser/pascaligo/ParserMain.ml

@@ -1,9 +1,47 @@
 (* Driver for the PascaLIGO parser *)
 
+module Region = Simple_utils.Region
+module SSet   = Set.Make (String)
+
 module IO =
   struct
-    let ext = ".ligo"
-    let options = EvalOpt.read "PascaLIGO" ext
+    let options = EvalOpt.(read ~lang:`PascaLIGO ~ext:".ligo")
+  end
+
+module SubIO =
+  struct
+    type options = <
+      libs    : string list;
+      verbose : SSet.t;
+      offsets : bool;
+      lang    : EvalOpt.language;
+      ext     : string;
+      mode    : [`Byte | `Point];
+      cmd     : EvalOpt.command;
+      mono    : bool
+    >
+
+    let options : options =
+      object
+        method libs    = IO.options#libs
+        method verbose = IO.options#verbose
+        method offsets = IO.options#offsets
+        method lang    = IO.options#lang
+        method ext     = IO.options#ext
+        method mode    = IO.options#mode
+        method cmd     = IO.options#cmd
+        method mono    = IO.options#mono
+      end
+
+    let make =
+      EvalOpt.make ~libs:options#libs
+                   ~verbose:options#verbose
+                   ~offsets:options#offsets
+                   ~lang:options#lang
+                   ~ext:options#ext
+                   ~mode:options#mode
+                   ~cmd:options#cmd
+                   ~mono:options#mono
   end
 
 module Parser =
@@ -23,130 +61,16 @@ module ParserLog =
 module Lexer = Lexer.Make (LexToken)
 
 module Unit =
-  ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(IO)
+  ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO)
 
 (* Main *)
 
-let issue_error error : ('a, string Region.reg) Stdlib.result =
-  Stdlib.Error (Unit.format_error ~offsets:IO.options#offsets
-                                  IO.options#mode error)
-
-let parse parser : ('a, string Region.reg) Stdlib.result =
-  try parser () with
-    (* Scoping errors *)
-
-  | Scoping.Error (Scoping.Duplicate_parameter name) ->
-      let token =
-        Lexer.Token.mk_ident name.Region.value name.Region.region in
-      (match token with
-         (* Cannot fail because [name] is a not a
-            reserved name for the lexer. *)
-         Stdlib.Error _ -> assert false
-       | Ok invalid ->
-           issue_error ("Duplicate parameter.\nHint: Change the name.\n",
-                        None, invalid))
-
-  | Scoping.Error (Scoping.Reserved_name name) ->
-      let token =
-        Lexer.Token.mk_ident name.Region.value name.Region.region in
-      (match token with
-         (* Cannot fail because [name] is a not a
-            reserved name for the lexer. *)
-         Stdlib.Error _ -> assert false
-       | Ok invalid ->
-          issue_error
-            ("Reserved name.\nHint: Change the name.\n", None, invalid))
-
-  | Scoping.Error (Scoping.Duplicate_variant name) ->
-      let token =
-        Lexer.Token.mk_constr name.Region.value name.Region.region in
-      let point = "Duplicate constructor in this sum type declaration.\n\
-                   Hint: Change the constructor.\n",
-                  None, token
-      in issue_error point
-
-  | Scoping.Error (Scoping.Non_linear_pattern var) ->
-      let token =
-        Lexer.Token.mk_ident var.Region.value var.Region.region in
-      (match token with
-         (* Cannot fail because [var] is a not a
-            reserved name for the lexer. *)
-         Stdlib.Error _ -> assert false
-       | Ok invalid ->
-           let point = "Repeated variable in this pattern.\n\
-                        Hint: Change the name.\n",
-                       None, invalid
-           in issue_error point)
-
-  | Scoping.Error (Scoping.Duplicate_field name) ->
-      let token =
-        Lexer.Token.mk_ident name.Region.value name.Region.region in
-      (match token with
-         (* Cannot fail because [name] is a not a
-            reserved name for the lexer. *)
-         Stdlib.Error _ -> assert false
-       | Ok invalid ->
-          let point =
-            "Duplicate field name in this record declaration.\n\
-             Hint: Change the name.\n",
-            None, invalid
-          in issue_error point)
-
-(* Preprocessing the input source with CPP *)
-
-module SSet = Utils.String.Set
-let sprintf = Printf.sprintf
-
-(* Path for CPP inclusions (#include) *)
-
-let lib_path =
-  match IO.options#libs with
-    [] -> ""
-  | libs -> let mk_I dir path = sprintf " -I %s%s" dir path
-           in List.fold_right mk_I libs ""
-
-let prefix =
-  match IO.options#input with
-    None | Some "-" -> "temp"
-  | Some file -> Filename.(file |> basename |> remove_extension)
-
-let suffix = ".pp" ^ IO.ext
-
-let pp_input =
-  if SSet.mem "cpp" IO.options#verbose
-  then prefix ^ suffix
-  else let pp_input, pp_out =
-         Filename.open_temp_file prefix suffix
-       in close_out pp_out; pp_input
-
-let cpp_cmd =
-  match IO.options#input with
-    None | Some "-" ->
-      sprintf "cpp -traditional-cpp%s - > %s"
-              lib_path pp_input
-  | Some file ->
-      sprintf "cpp -traditional-cpp%s %s > %s"
-              lib_path file pp_input
+let wrap = function
+  Stdlib.Ok _ -> flush_all ()
+| Error msg ->
+    (flush_all (); Printf.eprintf "\027[31m%s\027[0m%!" msg.Region.value)
 
 let () =
-  if Sys.command cpp_cmd <> 0 then
-    Printf.eprintf "External error: \"%s\" failed." cpp_cmd
-
-(* Instantiating the lexer and calling the parser *)
-
-let lexer_inst =
-  match Lexer.open_token_stream (Lexer.File pp_input) with
-    Ok instance ->
-      if IO.options#expr
-      then
-        match parse (fun () -> Unit.apply instance Unit.parse_expr) with
-          Stdlib.Ok _ -> ()
-        | Error Region.{value; _} ->
-            Printf.eprintf "\027[31m%s\027[0m%!" value
-      else
-        (match parse (fun () -> Unit.apply instance Unit.parse_contract) with
-          Stdlib.Ok _ -> ()
-        | Error Region.{value; _} ->
-            Printf.eprintf "\027[31m%s\027[0m%!" value)
-  | Stdlib.Error (Lexer.File_opening msg) ->
-      Printf.eprintf "\027[31m%s\027[0m%!" msg
+  match IO.options#input with
+    None -> Unit.contract_in_stdin () |> wrap
+  | Some file_path -> Unit.contract_in_file file_path |> wrap

src/passes/1-parser/pascaligo/Scoping.ml

@@ -1,5 +1,6 @@
 [@@@warning "-42"]
 
+module Region = Simple_utils.Region
 
 type t =
   Reserved_name       of AST.variable

src/passes/1-parser/pascaligo/Scoping.mli

@@ -1,5 +1,7 @@
 (* This module exports checks on scoping, called from the parser. *)
 
+module Region = Simple_utils.Region
+
 type t =
   Reserved_name       of AST.variable
 | Duplicate_parameter of AST.variable

src/passes/1-parser/pascaligo/Stubs/Simple_utils.ml

@@ -1,2 +0,0 @@
-module Region = Region
-module Pos = Pos

src/passes/1-parser/pascaligo/dune

@@ -20,6 +20,7 @@
      menhirLib
      parser_shared
      hex
+     Preprocessor
      simple-utils)
   (preprocess
     (pps bisect_ppx --conditional))
@@ -77,8 +78,8 @@
 ;  (targets error.messages)
 ;  (deps Parser.mly ParToken.mly error.messages.checked-in)
 ;  (action
-;   (with-stdout-to %{targets} 
-;   (bash 
+;   (with-stdout-to %{targets}
+;   (bash
 ;     "menhir \
 ;       --unused-tokens \
 ;       --list-errors  \
@@ -97,11 +98,11 @@
  (targets error.messages)
  (deps Parser.mly ParToken.mly error.messages.checked-in LexToken.mli)
  (action
-  (with-stdout-to %{targets} 
-  (run 
+  (with-stdout-to %{targets}
+  (run
     menhir
       --unused-tokens
-      --update-errors error.messages.checked-in 
+      --update-errors error.messages.checked-in
       --table
       --strict
       --external-tokens LexToken.mli
@@ -115,8 +116,8 @@
 (rule
   (target error.messages.new)
   (action
-    (with-stdout-to %{target} 
-      (run 
+    (with-stdout-to %{target}
+      (run
         menhir
           --unused-tokens
           --list-errors
@@ -135,7 +136,7 @@
   (name runtest)
   (deps error.messages error.messages.new)
   (action
-    (run 
+    (run
       menhir
         --unused-tokens
         --table
@@ -156,8 +157,8 @@
  (targets ParErr.ml)
  (deps Parser.mly ParToken.mly error.messages.checked-in LexToken.mli)
  (action
-  (with-stdout-to %{targets} 
-  (run 
+  (with-stdout-to %{targets}
+  (run
     menhir
       --unused-tokens
       --table
@@ -170,4 +171,3 @@
     )
  ))
 )
-

src/passes/1-parser/reasonligo.ml

@@ -2,31 +2,51 @@ open Trace
 
 module AST         = Parser_cameligo.AST
 module LexToken    = Parser_reasonligo.LexToken
-module Lexer       = Lexer.Make(LexToken)
+module Lexer       = 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        = Utils.String.Set
+module SSet        = Set.Make (String)
 
 (* Mock IOs TODO: Fill them with CLI options *)
 
-module type IO =
-  sig
-    val ext : string
-    val options : EvalOpt.options
-  end
+type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO]
 
-module PreIO =
+module SubIO =
   struct
-    let ext = ".ligo"
-    let pre_options =
-      EvalOpt.make ~libs:[]
-                   ~verbose:SSet.empty
-                   ~offsets:true
-                   ~mode:`Point
-                   ~cmd:EvalOpt.Quiet
-                   ~mono:false
+    type options = <
+      libs    : string list;
+      verbose : SSet.t;
+      offsets : bool;
+      lang    : language;
+      ext     : string;   (* ".religo" *)
+      mode    : [`Byte | `Point];
+      cmd     : EvalOpt.command;
+      mono    : bool
+    >
+
+    let options : options =
+      object
+        method libs    = []
+        method verbose = SSet.empty
+        method offsets = true
+        method lang    = `ReasonLIGO
+        method ext     = ".religo"
+        method mode    = `Point
+        method cmd     = EvalOpt.Quiet
+        method mono    = false
+      end
+
+    let make =
+      EvalOpt.make ~libs:options#libs
+                   ~verbose:options#verbose
+                   ~offsets:options#offsets
+                   ~lang:options#lang
+                   ~ext:options#ext
+                   ~mode:options#mode
+                   ~cmd:options#cmd
+                   ~mono:options#mono
   end
 
 module Parser =
@@ -43,8 +63,8 @@ module ParserLog =
     include Parser_cameligo.ParserLog
   end
 
-module PreUnit =
-  ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)
+module Unit =
+  ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO)
 
 module Errors =
   struct
@@ -55,23 +75,23 @@ module Errors =
 
     let wrong_function_arguments (expr: AST.expr) =
       let title () = "" in
-      let message () = "It looks like you are defining a function, \
-               however we do not\n\
-               understand the parameters declaration.\n\
-               Examples of valid functions:\n\
-               let x = (a: string, b: int) : int => 3;\n\
-               let tuple = ((a, b): (int, int)) => a + b; \n\
-               let x = (a: string) : string => \"Hello, \" ++ a;\n" 
-      in
+      let message () =
+        "It looks like you are defining a function, \
+         however we do not\n\
+         understand the parameters declaration.\n\
+         Examples of valid functions:\n\
+         let x = (a: string, b: int) : int => 3;\n\
+         let tuple = ((a, b): (int, int)) => a + b; \n\
+         let x = (a: string) : string => \"Hello, \" ++ a;\n" in
       let expression_loc = AST.expr_to_region expr in
       let data = [
         ("location",
          fun () -> Format.asprintf "%a" Location.pp_lift @@ expression_loc)]
       in error ~data title message
-    
-    let invalid_wild (expr: AST.expr) = 
+
+    let invalid_wild (expr: AST.expr) =
       let title () = "" in
-      let message () = 
+      let message () =
         "It looks like you are using a wild pattern where it cannot be used."
       in
       let expression_loc = AST.expr_to_region expr in
@@ -82,13 +102,12 @@ module Errors =
 
   end
 
-let parse (module IO : IO) parser =
-  let module Unit = PreUnit (IO) in
+let apply parser =
   let local_fail error =
     Trace.fail
     @@ Errors.generic
-    @@ Unit.format_error ~offsets:IO.options#offsets
-                        IO.options#mode error in
+    @@ Unit.format_error ~offsets:SubIO.options#offsets
+                        SubIO.options#mode error in
   match parser () with
     Stdlib.Ok semantic_value -> Trace.ok semantic_value
 
@@ -142,71 +161,18 @@ let parse (module IO : IO) parser =
   | exception SyntaxError.Error (SyntaxError.InvalidWild expr) ->
       Trace.fail @@ Errors.invalid_wild expr
 
-let parse_file (source: string) =
-  let module IO =
-    struct
-      let ext = PreIO.ext
-      let options =
-        PreIO.pre_options ~input:(Some source) ~expr:false
-    end in
-  let lib_path =
-    match IO.options#libs with
-      [] -> ""
-    | libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path
-             in List.fold_right mk_I libs "" in
-  let prefix =
-    match IO.options#input with
-      None | Some "-" -> "temp"
-    | Some file -> Filename.(remove_extension @@ basename file) in
-  let suffix = ".pp" ^ IO.ext in
-  let pp_input =
-    if   SSet.mem "cpp" IO.options#verbose
-    then prefix ^ suffix
-    else let pp_input, pp_out =
-           Filename.open_temp_file prefix suffix
-         in close_out pp_out; pp_input in
-  let cpp_cmd =
-    match IO.options#input with
-      None | Some "-" ->
-        Printf.sprintf "cpp -traditional-cpp%s - > %s"
-                       lib_path pp_input
-    | Some file ->
-        Printf.sprintf "cpp -traditional-cpp%s %s > %s"
-                       lib_path file pp_input in
-  let open Trace in
-  let%bind () = sys_command cpp_cmd in
-  let module Unit = PreUnit (IO) in
-  match Lexer.(open_token_stream @@ File pp_input) with
-    Ok instance ->
-      let thunk () = Unit.apply instance Unit.parse_contract
-      in parse (module IO) thunk
-  | Stdlib.Error (Lexer.File_opening msg) ->
-      Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg
+(* Parsing a contract in a file *)
 
-let parse_string (s: string) =
-  let module IO =
-    struct
-      let ext = PreIO.ext
-      let options = PreIO.pre_options ~input:None ~expr:false
-    end in
-  let module Unit = PreUnit (IO) in
-  match Lexer.(open_token_stream @@ String s) with
-    Ok instance ->
-      let thunk () = Unit.apply instance Unit.parse_contract
-      in parse (module IO) thunk
-  | Stdlib.Error (Lexer.File_opening msg) ->
-      Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg
+let parse_file source = apply (fun () -> Unit.contract_in_file source)
 
-let parse_expression (s: string)  =
-  let module IO =
-    struct
-      let ext = PreIO.ext
-      let options = PreIO.pre_options ~input:None ~expr:true
-    end in
-  let module Unit = PreUnit (IO) in
-  match Lexer.(open_token_stream @@ String s) with
-    Ok instance ->
-      let thunk () = Unit.apply instance Unit.parse_expr
-      in parse (module IO) thunk
-  | Stdlib.Error (Lexer.File_opening msg) ->
-      Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg
+(* Parsing a contract in a string *)
+
+let parse_string source = apply (fun () -> Unit.contract_in_string source)
+
+(* Parsing an expression in a string *)
+
+let parse_expression source = apply (fun () -> Unit.expr_in_string source)
+
+(* Preprocessing a contract in a file *)
+
+let preprocess source = apply (fun () -> Unit.preprocess source)

src/passes/1-parser/reasonligo.mli

@@ -0,0 +1,21 @@
+(** This file provides an interface to the ReasonLIGO parser. *)
+
+module AST = Parser_cameligo.AST
+
+(** Open a ReasonLIGO filename given by string and convert into an
+    abstract syntax tree. *)
+val parse_file : string -> AST.t Trace.result
+
+(** Convert a given string into a ReasonLIGO abstract syntax tree *)
+val parse_string : string -> AST.t Trace.result
+
+(** Parse a given string as a ReasonLIGO expression and return an
+    expression AST.
+
+    This is intended to be used for interactive interpreters, or other
+    scenarios where you would want to parse a ReasonLIGO expression
+    outside of a contract. *)
+val parse_expression : string -> AST.expr Trace.result
+
+(** Preprocess a given ReasonLIGO file and preprocess it. *)
+val preprocess : string -> Buffer.t Trace.result

src/passes/1-parser/reasonligo/.links

@@ -1,8 +1,5 @@
 $HOME/git/OCaml-build/Makefile
-$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli
-$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml
-$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli
-$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
+
 ../shared/Lexer.mli
 ../shared/Lexer.mll
 ../shared/EvalOpt.ml
@@ -17,13 +14,17 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
 ../shared/Utils.ml
 ../shared/ParserAPI.mli
 ../shared/ParserAPI.ml
+../shared/LexerUnit.mli
 ../shared/LexerUnit.ml
+../shared/ParserUnit.mli
 ../shared/ParserUnit.ml
-Stubs/Simple_utils.ml
+
 Stubs/Parser_cameligo.ml
+
 ../cameligo/AST.ml
 ../cameligo/ParserLog.mli
 ../cameligo/ParserLog.ml
 ../cameligo/Scoping.mli
 ../cameligo/Scoping.ml
-$HOME/git/ligo/_build/default/src/passes/1-parser/reasonligo/ParErr.ml
+
+$HOME/git/ligo/_build/default/src/passes/1-parser/reasonligo/ParErr.ml

src/passes/1-parser/reasonligo/LexerMain.ml

@@ -4,8 +4,7 @@ module Region = Simple_utils.Region
 
 module IO =
   struct
-    let ext = ".religo"
-    let options = EvalOpt.read "ReasonLIGO" ext
+    let options = EvalOpt.(read ~lang:`ReasonLIGO ~ext:".religo")
   end
 
 module M = LexerUnit.Make (IO) (Lexer.Make (LexToken))

src/passes/1-parser/reasonligo/Makefile.cfg

@@ -2,4 +2,4 @@ SHELL := dash
 BFLAGS := -strict-sequence -w +A-48-4 -g
 
 clean::
-> rm -f Parser.msg Parser.msg.map Parser.msg.states Version.ml
+> \rm -f Parser.msg Parser.msg.map Parser.msg.states Version.ml

src/passes/1-parser/reasonligo/Parser.mly

@@ -3,6 +3,7 @@
 
 [@@@warning "-42"]
 
+module Region = Simple_utils.Region
 open Region
 module AST = Parser_cameligo.AST
 open! AST
@@ -560,7 +561,7 @@ fun_expr:
             in raise (Error (WrongFunctionArguments e))
     in
     let binders = fun_args_to_pattern $1 in
-    let lhs_type = match $1 with 
+    let lhs_type = match $1 with
       EAnnot {value = {inside = _ , _, t; _}; region = r} -> Some (r,t)
       | _ -> None
     in

src/passes/1-parser/reasonligo/ParserMain.ml

@@ -1,9 +1,47 @@
-(** Driver for the ReasonLIGO parser *)
+(* Driver for the ReasonLIGO parser *)
+
+module Region = Simple_utils.Region
+module SSet   = Set.Make (String)
 
 module IO =
   struct
-    let ext = ".religo"
-    let options = EvalOpt.read "ReasonLIGO" ext
+    let options = EvalOpt.(read ~lang:`ReasonLIGO ~ext:".religo")
+  end
+
+module SubIO =
+  struct
+    type options = <
+      libs    : string list;
+      verbose : SSet.t;
+      offsets : bool;
+      lang    : EvalOpt.language;
+      ext     : string;
+      mode    : [`Byte | `Point];
+      cmd     : EvalOpt.command;
+      mono    : bool
+    >
+
+    let options : options =
+      object
+        method libs    = IO.options#libs
+        method verbose = IO.options#verbose
+        method offsets = IO.options#offsets
+        method lang    = IO.options#lang
+        method ext     = IO.options#ext
+        method mode    = IO.options#mode
+        method cmd     = IO.options#cmd
+        method mono    = IO.options#mono
+      end
+
+    let make =
+      EvalOpt.make ~libs:options#libs
+                   ~verbose:options#verbose
+                   ~offsets:options#offsets
+                   ~lang:options#lang
+                   ~ext:options#ext
+                   ~mode:options#mode
+                   ~cmd:options#cmd
+                   ~mono:options#mono
   end
 
 module Parser =
@@ -23,138 +61,16 @@ module ParserLog =
 module Lexer = Lexer.Make (LexToken)
 
 module Unit =
-  ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(IO)
+  ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO)
 
 (* Main *)
 
-let issue_error error : ('a, string Region.reg) Stdlib.result =
-  Stdlib.Error (Unit.format_error ~offsets:IO.options#offsets
-                                  IO.options#mode error)
-
-let parse parser : ('a, string Region.reg) Stdlib.result =
-  try parser () with
-    (* Ad hoc errors from the parser *)
-
-    SyntaxError.Error (SyntaxError.WrongFunctionArguments expr) ->
-    let msg = "It looks like you are defining a function, \
-               however we do not\n\
-               understand the parameters declaration.\n\
-               Examples of valid functions:\n\
-               let x = (a: string, b: int) : int => 3;\n\
-               let x = (a: string) : string => \"Hello, \" ++ a;\n"
-    and region = AST.expr_to_region expr in
-    let error  = Unit.short_error ~offsets:IO.options#offsets
-                                  IO.options#mode msg region
-    in Stdlib.Error Region.{value=error; region}
-
-  (* Scoping errors *)
-  | SyntaxError.Error (SyntaxError.InvalidWild expr) ->
-      let msg = "It looks like you are using a wild pattern where it cannot be used.\n"
-      and region = AST.expr_to_region expr in
-      let error  = Unit.short_error ~offsets:IO.options#offsets
-                                     IO.options#mode msg region
-      in Stdlib.Error Region.{value=error; region}
-  | Scoping.Error (Scoping.Reserved_name name) ->
-      let token =
-        Lexer.Token.mk_ident name.Region.value name.Region.region in
-      (match token with
-         (* Cannot fail because [name] is a not a
-            reserved name for the lexer. *)
-         Stdlib.Error _ -> assert false
-       | Ok invalid ->
-          issue_error
-            ("Reserved name.\nHint: Change the name.\n", None, invalid))
-
-  | Scoping.Error (Scoping.Duplicate_variant name) ->
-      let token =
-        Lexer.Token.mk_constr name.Region.value name.Region.region in
-      let point = "Duplicate constructor in this sum type declaration.\n\
-                   Hint: Change the constructor.\n",
-                  None, token
-      in issue_error point
-
-  | Scoping.Error (Scoping.Non_linear_pattern var) ->
-      let token =
-        Lexer.Token.mk_ident var.Region.value var.Region.region in
-      (match token with
-         (* Cannot fail because [var] is a not a
-            reserved name for the lexer. *)
-         Stdlib.Error _ -> assert false
-       | Ok invalid ->
-           let point = "Repeated variable in this pattern.\n\
-                        Hint: Change the name.\n",
-                       None, invalid
-           in issue_error point)
-
-  | Scoping.Error (Scoping.Duplicate_field name) ->
-      let token =
-        Lexer.Token.mk_ident name.Region.value name.Region.region in
-      (match token with
-         (* Cannot fail because [name] is a not a
-            reserved name for the lexer. *)
-         Stdlib.Error _ -> assert false
-       | Ok invalid ->
-          let point =
-            "Duplicate field name in this record declaration.\n\
-             Hint: Change the name.\n",
-            None, invalid
-          in issue_error point)
-
-(* Preprocessing the input source with CPP *)
-
-module SSet = Utils.String.Set
-let sprintf = Printf.sprintf
-
-(* Path for CPP inclusions (#include) *)
-
-let lib_path =
-  match IO.options#libs with
-    [] -> ""
-  | libs -> let mk_I dir path = sprintf " -I %s%s" dir path
-           in List.fold_right mk_I libs ""
-
-let prefix =
-  match IO.options#input with
-    None | Some "-" -> "temp"
-  | Some file -> Filename.(file |> basename |> remove_extension)
-
-let suffix = ".pp" ^ IO.ext
-
-let pp_input =
-  if SSet.mem "cpp" IO.options#verbose
-  then prefix ^ suffix
-  else let pp_input, pp_out =
-         Filename.open_temp_file prefix suffix
-       in close_out pp_out; pp_input
-
-let cpp_cmd =
-  match IO.options#input with
-    None | Some "-" ->
-      sprintf "cpp -traditional-cpp%s - > %s"
-              lib_path pp_input
-  | Some file ->
-      sprintf "cpp -traditional-cpp%s %s > %s"
-              lib_path file pp_input
+let wrap = function
+  Stdlib.Ok _ -> flush_all ()
+| Error msg ->
+    (flush_all (); Printf.eprintf "\027[31m%s\027[0m%!" msg.Region.value)
 
 let () =
-  if Sys.command cpp_cmd <> 0 then
-    Printf.eprintf "External error: \"%s\" failed." cpp_cmd
-
-(* Instantiating the lexer and calling the parser *)
-
-let lexer_inst =
-  match Lexer.open_token_stream (Lexer.File pp_input) with
-    Ok instance ->
-      if IO.options#expr
-      then
-        match parse (fun () -> Unit.apply instance Unit.parse_expr) with
-          Stdlib.Ok _ -> ()
-        | Error Region.{value; _} ->
-           Printf.eprintf "\027[31m%s\027[0m%!" value
-      else
-        (match parse (fun () -> Unit.apply instance Unit.parse_contract) with
-          Stdlib.Ok _ -> ()
-        | Error Region.{value; _} ->
-           Printf.eprintf "\027[31m%s\027[0m%!" value)
-  | Stdlib.Error (Lexer.File_opening msg) ->
-      Printf.eprintf "\027[31m%s\027[0m%!" msg
+  match IO.options#input with
+    None -> Unit.contract_in_stdin () |> wrap
+  | Some file_path -> Unit.contract_in_file file_path |> wrap

src/passes/1-parser/reasonligo/Stubs/Simple_utils.ml

@@ -1,2 +0,0 @@
-module Region = Region
-module Pos = Pos

src/passes/1-parser/reasonligo/dune

@@ -73,14 +73,13 @@
   (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
-
 ;; Generate error messages from scratch
 ; (rule
 ;  (targets error.messages)
 ;  (deps Parser.mly ParToken.mly error.messages.checked-in)
 ;  (action
-;   (with-stdout-to %{targets} 
-;   (bash 
+;   (with-stdout-to %{targets}
+;   (bash
 ;     "menhir \
 ;       --unused-tokens \
 ;       --list-errors  \
@@ -99,11 +98,11 @@
  (targets error.messages)
  (deps Parser.mly ParToken.mly error.messages.checked-in LexToken.mli)
  (action
-  (with-stdout-to %{targets} 
-  (run 
-    menhir
+  (with-stdout-to %{targets}
+  (run
+     menhir
       --unused-tokens
-      --update-errors error.messages.checked-in 
+      --update-errors error.messages.checked-in
       --table
       --strict
       --external-tokens LexToken.mli
@@ -117,8 +116,8 @@
 (rule
   (target error.messages.new)
   (action
-    (with-stdout-to %{target} 
-      (run 
+    (with-stdout-to %{target}
+      (run
         menhir
           --unused-tokens
           --list-errors
@@ -137,7 +136,7 @@
   (name runtest)
   (deps error.messages error.messages.new)
   (action
-    (run 
+    (run
       menhir
         --unused-tokens
         --table
@@ -158,8 +157,8 @@
  (targets ParErr.ml)
  (deps Parser.mly ParToken.mly error.messages.checked-in LexToken.mli)
  (action
-  (with-stdout-to %{targets} 
-  (run 
+  (with-stdout-to %{targets}
+  (run
     menhir
       --unused-tokens
       --table

src/passes/1-parser/shared/.links

@@ -1,7 +1,7 @@
 $HOME/git/OCaml-build/Makefile
 $HOME/git/OCaml-build/Makefile.cfg
+
 $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli
 $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml
 $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli
 $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
-$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml

src/passes/1-parser/shared/EvalOpt.ml

@@ -1,45 +1,62 @@
-(** Parsing command-line options *)
+(* Parsing command-line options *)
+
+(* The type [command] denotes some possible behaviours of the
+    compiler. *)
 
-(** The type [command] denotes some possible behaviours of the
-    compiler.
-*)
 type command = Quiet | Copy | Units | Tokens
 
-(** The type [options] gathers the command-line options.
-*)
+type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO]
+
+let lang_to_string = function
+  `PascaLIGO -> "PascaLIGO"
+| `CameLIGO -> "CameLIGO"
+| `ReasonLIGO -> "ReasonLIGO"
+
+(* The type [options] gathers the command-line options. *)
+
+module SSet = Set.Make (String)
+
 type options = <
   input   : string option;
   libs    : string list;
-  verbose : Utils.String.Set.t;
+  verbose : SSet.t;
   offsets : bool;
+  lang    : language;
+  ext     : string;           (* ".ligo", ".mligo", ".religo" *)
   mode    : [`Byte | `Point];
   cmd     : command;
   mono    : bool;
   expr    : bool
 >
 
-let make ~input ~libs ~verbose ~offsets ~mode ~cmd ~mono ~expr =
+let make ~input ~libs ~verbose ~offsets ~lang ~ext ~mode ~cmd ~mono ~expr : options =
   object
     method input   = input
     method libs    = libs
     method verbose = verbose
     method offsets = offsets
+    method lang    = lang
+    method ext     = ext
     method mode    = mode
     method cmd     = cmd
     method mono    = mono
     method expr    = expr
   end
 
-(** {1 Auxiliary functions} *)
+(* Auxiliary functions *)
 
 let  printf = Printf.printf
 let sprintf = Printf.sprintf
 let   print = print_endline
 
-let abort msg =
-  Utils.highlight (sprintf "Command-line error: %s\n" msg); exit 1
+(* Printing a string in red to standard error *)
 
-(** {1 Help} *)
+let highlight msg = Printf.eprintf "\027[31m%s\027[0m%!" msg
+
+let abort msg =
+  highlight (sprintf "Command-line error: %s\n" msg); exit 1
+
+(* Help *)
 
 let help language extension () =
   let file = Filename.basename Sys.argv.(0) in
@@ -55,16 +72,16 @@ let help language extension () =
   print "      --bytes            Bytes for source locations";
   print "      --mono             Use Menhir monolithic API";
   print "      --expr             Parse an expression";
-  print "      --verbose=<stages> cli, cpp, ast-tokens, ast (colon-separated)";
+  print "      --verbose=<stages> cli, preproc, ast-tokens, ast (colon-separated)";
   print "      --version          Commit hash on stdout";
   print "  -h, --help             This help";
   exit 0
 
-(** {1 Version} *)
+(* Version *)
 
 let version () = printf "%s\n" Version.version; exit 0
 
-(** {1 Specifying the command-line options a la GNU} *)
+(* Specifying the command-line options a la GNU *)
 
 let copy     = ref false
 and tokens   = ref false
@@ -72,7 +89,7 @@ and units    = ref false
 and quiet    = ref false
 and columns  = ref false
 and bytes    = ref false
-and verbose  = ref Utils.String.Set.empty
+and verbose  = ref SSet.empty
 and input    = ref None
 and libs     = ref []
 and verb_str = ref ""
@@ -84,11 +101,12 @@ let split_at_colon = Str.(split (regexp ":"))
 let add_path p = libs := !libs @ split_at_colon p
 
 let add_verbose d =
-  verbose := List.fold_left (Utils.swap Utils.String.Set.add)
+  verbose := List.fold_left (fun x y -> SSet.add y x)
                             !verbose
                             (split_at_colon d)
 
 let specs language extension =
+  let language = lang_to_string language in
   let open! Getopt in [
     'I',     nolong,    None, Some add_path;
     'c',     "copy",    set copy true, None;
@@ -105,17 +123,15 @@ let specs language extension =
   ]
 ;;
 
-(** Handler of anonymous arguments
-*)
+(* Handler of anonymous arguments *)
+
 let anonymous arg =
   match !input with
       None -> input := Some arg
-  | Some s -> Printf.printf "s=%s\n" s;
-             abort (sprintf "Multiple inputs")
-;;
+  | Some _ -> abort (sprintf "Multiple inputs")
+
+(* Checking options and exporting them as non-mutable values *)
 
-(** Checking options and exporting them as non-mutable values
-*)
 let string_of convert = function
     None -> "None"
 | Some s -> sprintf "Some %s" (convert s)
@@ -139,21 +155,20 @@ let print_opt () =
   printf "verbose  = %s\n" !verb_str;
   printf "input    = %s\n" (string_of quote !input);
   printf "libs     = %s\n" (string_of_path !libs)
-;;
 
-let check extension =
+let check lang ext =
   let () =
-    if Utils.String.Set.mem "cli" !verbose then print_opt () in
+    if SSet.mem "cli" !verbose then print_opt () in
 
   let input =
     match !input with
-      None | Some "-" -> !input
+      None | Some "-" -> None
     | Some file_path ->
-        if   Filename.check_suffix file_path extension
+        if   Filename.check_suffix file_path ext
         then if   Sys.file_exists file_path
              then Some file_path
              else abort "Source file not found."
-        else abort ("Source file lacks the extension " ^ extension ^ ".") in
+        else abort ("Source file lacks the extension " ^ ext ^ ".") in
 
   (* Exporting remaining options as non-mutable values *)
 
@@ -169,7 +184,7 @@ let check extension =
   and libs    = !libs in
 
   let () =
-    if Utils.String.Set.mem "cli" verbose then
+    if SSet.mem "cli" verbose then
       begin
         printf "\nEXPORTED COMMAND LINE\n";
         printf "copy     = %b\n" copy;
@@ -194,16 +209,16 @@ let check extension =
     | false, false, false,  true -> Tokens
     | _ -> abort "Choose one of -q, -c, -u, -t."
 
-  in make ~input ~libs ~verbose ~offsets ~mode ~cmd ~mono ~expr
+  in make ~input ~libs ~verbose ~offsets ~mode ~cmd ~mono ~expr ~lang ~ext
 
-(** {1 Parsing the command-line options} *)
+(* Parsing the command-line options *)
 
-let read language extension =
+let read ~lang ~ext =
   try
-    Getopt.parse_cmdline (specs language extension) anonymous;
+    Getopt.parse_cmdline (specs lang ext) anonymous;
     (verb_str :=
        let apply e a =
          if a = "" then e else Printf.sprintf "%s, %s" e a
-       in Utils.String.Set.fold apply !verbose "");
-    check extension
+       in SSet.fold apply !verbose "");
+    check lang ext
   with Getopt.Error msg -> abort msg

src/passes/1-parser/shared/EvalOpt.mli

@@ -48,11 +48,20 @@ type command = Quiet | Copy | Units | Tokens
           expressions is used, otherwise a full-fledged contract is
           expected.}
 } *)
+
+type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO]
+
+val lang_to_string : language -> string
+
+module SSet : Set.S with type elt = string and type t = Set.Make(String).t
+
 type options = <
   input   : string option;
   libs    : string list;
-  verbose : Utils.String.Set.t;
+  verbose : SSet.t;
   offsets : bool;
+  lang    : language;
+  ext     : string;   (* ".ligo", ".mligo", ".religo" *)
   mode    : [`Byte | `Point];
   cmd     : command;
   mono    : bool;
@@ -62,8 +71,10 @@ type options = <
 val make :
   input:string option ->
   libs:string list ->
-  verbose:Utils.String.Set.t ->
+  verbose:SSet.t ->
   offsets:bool ->
+  lang:language ->
+  ext:string ->
   mode:[`Byte | `Point] ->
   cmd:command ->
   mono:bool ->
@@ -71,7 +82,7 @@ val make :
   options
 
 (** Parsing the command-line options on stdin.  The first parameter is
-   the name of the concrete syntax, e.g., "pascaligo", and the second
-   is the file extension, e.g., ".ligo".
- *)
-val read : string -> string -> options
+   the name of the concrete syntax, e.g., [PascaLIGO], and the second
+   is the expected file extension, e.g., ".ligo". *)
+
+val read : lang:language -> ext:string -> options

src/passes/1-parser/shared/Lexer.mli

@@ -135,7 +135,14 @@ module type S =
 
     val slide : token -> window -> window
 
+    type input =
+      File    of file_path
+    | String  of string
+    | Channel of in_channel
+    | Buffer  of Lexing.lexbuf
+
     type instance = {
+      input    : input;
       read     : log:logger -> Lexing.lexbuf -> token;
       buffer   : Lexing.lexbuf;
       get_win  : unit -> window;
@@ -145,16 +152,15 @@ module type S =
       close    : unit -> unit
     }
 
-    type input =
-      File    of file_path (* "-" means stdin *)
-    | Stdin
-    | String  of string
-    | Channel of in_channel
-    | Buffer  of Lexing.lexbuf
-
     type open_err = File_opening of string
 
-    val open_token_stream : input -> (instance, open_err) Stdlib.result
+    val lexbuf_from_input :
+      input -> (Lexing.lexbuf * (unit -> unit), open_err) Stdlib.result
+
+    type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO]
+
+    val open_token_stream :
+      language -> input -> (instance, open_err) Stdlib.result
 
     (* Error reporting *)
 

src/passes/1-parser/shared/Lexer.mll

@@ -157,7 +157,14 @@ module type S =
 
     val slide : token -> window -> window
 
+    type input =
+      File    of file_path
+    | String  of string
+    | Channel of in_channel
+    | Buffer  of Lexing.lexbuf
+
     type instance = {
+      input    : input;
       read     : log:logger -> Lexing.lexbuf -> token;
       buffer   : Lexing.lexbuf;
       get_win  : unit -> window;
@@ -167,16 +174,15 @@ module type S =
       close    : unit -> unit
     }
 
-    type input =
-      File    of file_path (* "-" means stdin *)
-    | Stdin
-    | String  of string
-    | Channel of in_channel
-    | Buffer  of Lexing.lexbuf
-
     type open_err = File_opening of string
 
-    val open_token_stream : input -> (instance, open_err) Stdlib.result
+    val lexbuf_from_input :
+      input -> (Lexing.lexbuf * (unit -> unit), open_err) Stdlib.result
+
+    type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO]
+
+    val open_token_stream :
+      language -> input -> (instance, open_err) Stdlib.result
 
     (* Error reporting *)
 
@@ -254,7 +260,7 @@ module Make (Token: TOKEN) : (S with module Token = Token) =
                     Nil -> One token
     | One t | Two (t,_) -> Two (token,t)
 
-    (** Beyond tokens, the result of lexing is a state. The type
+    (* Beyond tokens, the result of lexing is a state. The type
        [state] represents the logical state of the lexing engine, that
        is, a value which is threaded during scanning and which denotes
        useful, high-level information beyond what the type
@@ -292,6 +298,9 @@ module Make (Token: TOKEN) : (S with module Token = Token) =
        it to [decoder]. See the documentation of the third-party
        library Uutf.
      *)
+
+    type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO]
+
     type state = {
       units   : (Markup.t list * token) FQueue.t;
       markup  : Markup.t list;
@@ -299,7 +308,8 @@ module Make (Token: TOKEN) : (S with module Token = Token) =
       last    : Region.t;
       pos     : Pos.t;
       decoder : Uutf.decoder;
-      supply  : Bytes.t -> int -> int -> unit
+      supply  : Bytes.t -> int -> int -> unit;
+      lang    : language
     }
 
     (* The call [enqueue (token, state)] updates functionally the
@@ -388,7 +398,7 @@ module Make (Token: TOKEN) : (S with module Token = Token) =
     | Unterminated_string
     | Unterminated_integer
     | Odd_lengthed_bytes
-    | Unterminated_comment
+    | Unterminated_comment of string
     | Orphan_minus
     | Non_canonical_zero
     | Negative_byte_sequence
@@ -401,51 +411,51 @@ module Make (Token: TOKEN) : (S with module Token = Token) =
 
     let error_to_string = function
       Invalid_utf8_sequence ->
-        "Invalid UTF-8 sequence.\n"
+        "Invalid UTF-8 sequence."
     | Unexpected_character c ->
-        sprintf "Unexpected character '%s'.\n" (Char.escaped c)
+        sprintf "Unexpected character '%s'." (Char.escaped c)
     | Undefined_escape_sequence ->
         "Undefined escape sequence.\n\
-         Hint: Remove or replace the sequence.\n"
+         Hint: Remove or replace the sequence."
     | Missing_break ->
         "Missing break.\n\
-         Hint: Insert some space.\n"
+         Hint: Insert some space."
     | Unterminated_string ->
         "Unterminated string.\n\
-         Hint: Close with double quotes.\n"
+         Hint: Close with double quotes."
     | Unterminated_integer ->
         "Unterminated integer.\n\
-         Hint: Remove the sign or proceed with a natural number.\n"
+         Hint: Remove the sign or proceed with a natural number."
     | Odd_lengthed_bytes ->
         "The length of the byte sequence is an odd number.\n\
-         Hint: Add or remove a digit.\n"
-    | Unterminated_comment ->
-        "Unterminated comment.\n\
-         Hint: Close with \"*)\".\n"
+         Hint: Add or remove a digit."
+    | Unterminated_comment ending ->
+        sprintf "Unterminated comment.\n\
+                 Hint: Close with \"%s\"." ending
     | Orphan_minus ->
         "Orphan minus sign.\n\
-         Hint: Remove the trailing space.\n"
+         Hint: Remove the trailing space."
     | Non_canonical_zero ->
         "Non-canonical zero.\n\
-         Hint: Use 0.\n"
+         Hint: Use 0."
     | Negative_byte_sequence ->
         "Negative byte sequence.\n\
-         Hint: Remove the leading minus sign.\n"
+         Hint: Remove the leading minus sign."
     | Broken_string ->
         "The string starting here is interrupted by a line break.\n\
          Hint: Remove the break, close the string before or insert a \
-         backslash.\n"
+         backslash."
     | Invalid_character_in_string ->
         "Invalid character in string.\n\
-         Hint: Remove or replace the character.\n"
+         Hint: Remove or replace the character."
     | Reserved_name s ->
         sprintf "Reserved name: \"%s\".\n\
-         Hint: Change the name.\n" s
+         Hint: Change the name." s
     | Invalid_symbol ->
         "Invalid symbol.\n\
-         Hint: Check the LIGO syntax you use.\n"
+         Hint: Check the LIGO syntax you use."
     | Invalid_natural ->
-        "Invalid natural."
+        "Invalid natural number."
     | Invalid_attribute ->
         "Invalid attribute."
 
@@ -454,7 +464,7 @@ module Make (Token: TOKEN) : (S with module Token = Token) =
     let format_error ?(offsets=true) mode Region.{region; value} ~file =
       let msg = error_to_string value
       and reg = region#to_string ~file ~offsets mode in
-      let value = sprintf "Lexical error %s:\n%s" reg msg
+      let value = sprintf "Lexical error %s:\n%s\n" reg msg
       in Region.{value; region}
 
     let fail region value = raise (Error Region.{region; value})
@@ -618,16 +628,16 @@ rule init state = parse
 and scan state = parse
   nl                     { scan (push_newline state lexbuf) lexbuf }
 | ' '+                   { scan (push_space   state lexbuf) lexbuf }
-| '\t'+                  { scan (push_tabs state lexbuf) lexbuf    }
+| '\t'+                  { scan (push_tabs    state lexbuf) lexbuf }
 | ident                  { mk_ident        state lexbuf |> enqueue  }
 | constr                 { mk_constr       state lexbuf |> enqueue  }
 | bytes                  { mk_bytes seq    state lexbuf |> enqueue  }
 | natural 'n'            { mk_nat          state lexbuf |> enqueue  }
 | natural "mutez"        { mk_mutez        state lexbuf |> enqueue  }
 | natural "tz"
-| natural "tez"          { mk_tez           state lexbuf |> enqueue }
+| natural "tez"          { mk_tez          state lexbuf |> enqueue  }
 | decimal "tz"
-| decimal "tez"          { mk_tez_decimal   state lexbuf |> enqueue }
+| decimal "tez"          { mk_tez_decimal  state lexbuf |> enqueue  }
 | natural                { mk_int          state lexbuf |> enqueue  }
 | symbol                 { mk_sym          state lexbuf |> enqueue  }
 | eof                    { mk_eof          state lexbuf |> enqueue  }
@@ -638,31 +648,43 @@ and scan state = parse
          let thread = {opening; len=1; acc=['"']} in
          scan_string thread state lexbuf |> mk_string |> enqueue }
 
-| "(*" { let opening, _, state = sync state lexbuf in
-         let thread = {opening; len=2; acc=['*';'(']} in
-         let state  = scan_block thread state lexbuf |> push_block
-         in scan state lexbuf }
+| "(*" { if state.lang = `PascaLIGO || state.lang = `CameLIGO then
+           let opening, _, state = sync state lexbuf in
+           let thread = {opening; len=2; acc=['*';'(']} in
+           let state  = scan_pascaligo_block thread state lexbuf |> push_block
+           in scan state lexbuf
+         else (rollback lexbuf; scan_two_sym state lexbuf)
+       }
+
+| "/*" { if state.lang = `ReasonLIGO then
+           let opening, _, state = sync state lexbuf in
+           let thread = {opening; len=2; acc=['*';'/']} in
+           let state  = scan_reasonligo_block thread state lexbuf |> push_block
+           in scan state lexbuf
+         else (rollback lexbuf; scan_two_sym state lexbuf)
+       }
 
 | "//" { let opening, _, state = sync state lexbuf in
          let thread = {opening; len=2; acc=['/';'/']} in
          let state  = scan_line thread state lexbuf |> push_line
          in scan state lexbuf }
 
-  (* Management of #include CPP directives
+  (* Management of #include preprocessing directives
 
-    An input LIGO program may contain GNU CPP (C preprocessor)
-    directives, and the entry modules (named *Main.ml) run CPP on them
-    in traditional mode:
+    An input LIGO program may contain preprocessing directives, and
+    the entry modules (named *Main.ml) run the preprocessor on them,
+    as if using the GNU C preprocessor in traditional mode:
 
     https://gcc.gnu.org/onlinedocs/cpp/Traditional-Mode.html
 
-      The main interest in using CPP is that it can stand for a poor
-    man's (flat) module system for LIGO thanks to #include
-    directives, and the traditional mode leaves the markup mostly
-    undisturbed.
+      The main interest in using a preprocessor is that it can stand
+    for a poor man's (flat) module system for LIGO thanks to #include
+    directives, and the equivalent of the traditional mode leaves the
+    markup undisturbed.
 
-      Some of the #line resulting from processing #include directives
-    deal with system file headers and thus have to be ignored for our
+      Contrary to the C preprocessor, our preprocessor does not
+    generate #line resulting from processing #include directives deal
+    with system file headers and thus have to be ignored for our
     purpose. Moreover, these #line directives may also carry some
     additional flags:
 
@@ -671,7 +693,7 @@ and scan state = parse
     of which 1 and 2 indicate, respectively, the start of a new file
     and the return from a file (after its inclusion has been
     processed).
-  *)
+   *)
 
 | '#' blank* ("line" blank+)? (natural as line) blank+
     '"' (string as file) '"' {
@@ -714,6 +736,14 @@ and scan state = parse
 | _ as c { let region, _, _ = sync state lexbuf
            in fail region (Unexpected_character c) }
 
+(* Scanning two symbols *)
+
+and scan_two_sym state = parse
+  symbol { scan_one_sym (mk_sym state lexbuf |> enqueue) lexbuf }
+
+and scan_one_sym state = parse
+  symbol { scan (mk_sym state lexbuf |> enqueue) lexbuf }
+
 (* Scanning CPP #include flags *)
 
 and scan_flags state acc = parse
@@ -745,39 +775,70 @@ and scan_string thread state = parse
 
 (* Finishing a block comment
 
-   (Note for Emacs: ("(*")
-   The lexing of block comments must take care of embedded block
-   comments that may occur within, as well as strings, so no substring
-   "*)" may inadvertently close the block. This is the purpose
-   of the first case of the scanner [scan_block].
+   (For Emacs: ("(*") The lexing of block comments must take care of
+   embedded block comments that may occur within, as well as strings,
+   so no substring "*/" or "*)" may inadvertently close the
+   block. This is the purpose of the first case of the scanners
+   [scan_pascaligo_block] and [scan_reasonligo_block].
 *)
 
-and scan_block thread state = parse
+and scan_pascaligo_block thread state = parse
   '"' | "(*" { let opening = thread.opening in
                let opening', lexeme, state = sync state lexbuf in
                let thread = push_string lexeme thread in
                let thread = {thread with opening=opening'} in
                let next   = if lexeme = "\"" then scan_string
-                            else scan_block in
+                            else scan_pascaligo_block in
                let thread, state = next thread state lexbuf in
                let thread = {thread with opening}
-               in scan_block thread state lexbuf }
+               in scan_pascaligo_block thread state lexbuf }
 | "*)"       { let _, lexeme, state = sync state lexbuf
                in push_string lexeme thread, state }
 | nl as nl   { let ()     = Lexing.new_line lexbuf
                and state  = {state with pos = state.pos#new_line nl}
                and thread = push_string nl thread
-               in scan_block thread state lexbuf }
-| eof        { fail thread.opening Unterminated_comment }
+               in scan_pascaligo_block thread state lexbuf }
+| eof        { fail thread.opening (Unterminated_comment "*)") }
 | _          { let ()     = rollback lexbuf in
                let len    = thread.len in
                let thread,
-                   status = scan_utf8 thread state lexbuf in
+                   status = scan_utf8 "*)" thread state lexbuf in
                let delta  = thread.len - len in
                let pos    = state.pos#shift_one_uchar delta in
                match status with
-                 None -> scan_block thread {state with pos} lexbuf
-               | Some error ->
+                 Stdlib.Ok () ->
+                   scan_pascaligo_block thread {state with pos} lexbuf
+               | Error error ->
+                   let region = Region.make ~start:state.pos ~stop:pos
+                   in fail region error }
+
+and scan_reasonligo_block thread state = parse
+  '"' | "/*" { let opening = thread.opening in
+               let opening', lexeme, state = sync state lexbuf in
+               let thread = push_string lexeme thread in
+               let thread = {thread with opening=opening'} in
+               let next   = if lexeme = "\"" then scan_string
+                            else scan_reasonligo_block in
+               let thread, state = next thread state lexbuf in
+               let thread = {thread with opening}
+               in scan_reasonligo_block thread state lexbuf }
+| "*/"       { let _, lexeme, state = sync state lexbuf
+               in push_string lexeme thread, state }
+| nl as nl   { let ()     = Lexing.new_line lexbuf
+               and state  = {state with pos = state.pos#new_line nl}
+               and thread = push_string nl thread
+               in scan_reasonligo_block thread state lexbuf }
+| eof        { fail thread.opening (Unterminated_comment "*/") }
+| _          { let ()     = rollback lexbuf in
+               let len    = thread.len in
+               let thread,
+                   status = scan_utf8 "*/" thread state lexbuf in
+               let delta  = thread.len - len in
+               let pos    = state.pos#shift_one_uchar delta in
+               match status with
+                 Stdlib.Ok () ->
+                   scan_reasonligo_block thread {state with pos} lexbuf
+               | Error error ->
                    let region = Region.make ~start:state.pos ~stop:pos
                    in fail region error }
 
@@ -792,24 +853,36 @@ and scan_line thread state = parse
 | _        { let     () = rollback lexbuf in
              let len    = thread.len in
              let thread,
-                 status = scan_utf8 thread state lexbuf in
+                 status = scan_utf8_inline thread state lexbuf in
              let delta  = thread.len - len in
              let pos    = state.pos#shift_one_uchar delta in
              match status with
-               None -> scan_line thread {state with pos} lexbuf
-             | Some error ->
+               Stdlib.Ok () ->
+                 scan_line thread {state with pos} lexbuf
+             | Error error ->
                  let region = Region.make ~start:state.pos ~stop:pos
                  in fail region error }
 
-and scan_utf8 thread state = parse
-     eof { fail thread.opening Unterminated_comment }
+and scan_utf8 closing thread state = parse
+     eof { fail thread.opening (Unterminated_comment closing) }
 | _ as c { let thread = push_char c thread in
            let lexeme = Lexing.lexeme lexbuf in
            let () = state.supply (Bytes.of_string lexeme) 0 1 in
            match Uutf.decode state.decoder with
-             `Uchar _     -> thread, None
-           | `Malformed _ -> thread, Some Invalid_utf8_sequence
-           | `Await       -> scan_utf8 thread state lexbuf
+             `Uchar _     -> thread, Stdlib.Ok ()
+           | `Malformed _ -> thread, Stdlib.Error Invalid_utf8_sequence
+           | `Await       -> scan_utf8 closing thread state lexbuf
+           | `End         -> assert false }
+
+and scan_utf8_inline thread state = parse
+     eof { thread, Stdlib.Ok () }
+| _ as c { let thread = push_char c thread in
+           let lexeme = Lexing.lexeme lexbuf in
+           let () = state.supply (Bytes.of_string lexeme) 0 1 in
+           match Uutf.decode state.decoder with
+             `Uchar _     -> thread, Stdlib.Ok ()
+           | `Malformed _ -> thread, Stdlib.Error Invalid_utf8_sequence
+           | `Await       -> scan_utf8_inline thread state lexbuf
            | `End         -> assert false }
 
 (* END LEXER DEFINITION *)
@@ -863,7 +936,14 @@ and scan_utf8 thread state = parse
 
 type logger = Markup.t list -> token -> unit
 
+type input =
+  File    of file_path
+| String  of string
+| Channel of in_channel
+| Buffer  of Lexing.lexbuf
+
 type instance = {
+  input    : input;
   read     : log:logger -> Lexing.lexbuf -> token;
   buffer   : Lexing.lexbuf;
   get_win  : unit -> window;
@@ -873,19 +953,29 @@ type instance = {
   close    : unit -> unit
 }
 
-type input =
-  File    of file_path (* "-" means stdin *)
-| Stdin
-| String  of string
-| Channel of in_channel
-| Buffer  of Lexing.lexbuf
-
 type open_err = File_opening of string
 
-let open_token_stream input =
+let lexbuf_from_input = function
+  File path ->
+   (try
+      let chan = open_in path in
+      let close () = close_in chan in
+      let lexbuf = Lexing.from_channel chan in
+      let () =
+        let open Lexing in
+        lexbuf.lex_curr_p <- {lexbuf.lex_curr_p with pos_fname = path}
+      in Ok (lexbuf, close)
+    with Sys_error msg -> Stdlib.Error (File_opening msg))
+| String s ->
+    Ok (Lexing.from_string s, fun () -> ())
+| Channel chan ->
+    let close () = close_in chan in
+    Ok (Lexing.from_channel chan, close)
+| Buffer b -> Ok (b, fun () -> ())
+
+let open_token_stream (lang: language) input =
   let file_path  = match input with
-                     File file_path ->
-                       if file_path = "-" then "" else file_path
+                     File path -> path
                    | _ -> "" in
   let        pos = Pos.min ~file:file_path in
   let    buf_reg = ref (pos#byte, pos#byte)
@@ -898,7 +988,8 @@ let open_token_stream input =
                         pos;
                         markup = [];
                         decoder;
-                        supply} in
+                        supply;
+                        lang} in
 
   let get_pos  () = !state.pos
   and get_last () = !state.last
@@ -966,32 +1057,14 @@ let open_token_stream input =
         check_right_context token buffer;
         patch_buffer (Token.to_region token)#byte_pos buffer;
         token in
-
-  let buf_close_res =
-    match input with
-      File "" | File "-" | Stdin ->
-        Ok (Lexing.from_channel stdin, fun () -> close_in stdin)
-    | File path ->
-       (try
-          let chan = open_in path in
-          let close () = close_in chan in
-          Ok (Lexing.from_channel chan, close)
-        with
-          Sys_error msg -> Stdlib.Error (File_opening msg))
-    | String s ->
-        Ok (Lexing.from_string s, fun () -> ())
-    | Channel chan ->
-        let close () = close_in chan in
-        Ok (Lexing.from_channel chan, close)
-    | Buffer b -> Ok (b, fun () -> ()) in
-  match buf_close_res with
+  match lexbuf_from_input input with
     Ok (buffer, close) ->
       let () =
         match input with
           File path when path <> "" -> reset ~file:path buffer
         | _ -> () in
       let instance = {
-        read; buffer; get_win; get_pos; get_last; get_file; close}
+        input; read; buffer; get_win; get_pos; get_last; get_file; close}
       in Ok instance
   | Error _ as e -> e
 

src/passes/1-parser/shared/LexerLog.ml

@@ -7,15 +7,22 @@ module type S =
     module Lexer : Lexer.S
 
     val output_token :
-      ?offsets:bool -> [`Byte | `Point] ->
-      EvalOpt.command -> out_channel ->
-      Markup.t list -> Lexer.token -> unit
+      ?offsets:bool ->
+      [`Byte | `Point] ->
+      EvalOpt.command ->
+      out_channel ->
+      Markup.t list ->
+      Lexer.token ->
+      unit
 
     type file_path = string
 
     val trace :
-      ?offsets:bool -> [`Byte | `Point] ->
-      file_path option -> EvalOpt.command ->
+      ?offsets:bool ->
+      [`Byte | `Point] ->
+      EvalOpt.language ->
+      Lexer.input ->
+      EvalOpt.command ->
       (unit, string Region.reg) Stdlib.result
   end
 
@@ -49,16 +56,12 @@ module Make (Lexer: Lexer.S) : (S with module Lexer = Lexer) =
 
     type file_path = string
 
-    let trace ?(offsets=true) mode file_path_opt command :
+    let trace ?(offsets=true) mode lang input command :
           (unit, string Region.reg) Stdlib.result =
-      let input =
-        match file_path_opt with
-          Some file_path -> Lexer.File file_path
-        | None -> Lexer.Stdin in
-      match Lexer.open_token_stream input with
+      match Lexer.open_token_stream lang input with
         Ok Lexer.{read; buffer; close; _} ->
           let log = output_token ~offsets mode command stdout
-          and close_all () = close (); close_out stdout in
+          and close_all () = flush_all (); close () in
           let rec iter () =
             match read ~log buffer with
               token ->
@@ -66,15 +69,11 @@ module Make (Lexer: Lexer.S) : (S with module Lexer = Lexer) =
                 then Stdlib.Ok ()
                 else iter ()
             | exception Lexer.Error error ->
-                let file =
-                  match file_path_opt with
-                    None | Some "-" -> false
-                  |         Some _  -> true in
                 let msg =
-                  Lexer.format_error ~offsets mode ~file error
+                  Lexer.format_error ~offsets mode ~file:true error
                 in Stdlib.Error msg in
             let result = iter ()
             in close_all (); result
         | Stdlib.Error (Lexer.File_opening msg) ->
-            close_out stdout; Stdlib.Error (Region.wrap_ghost msg)
+            flush_all (); Stdlib.Error (Region.wrap_ghost msg)
   end

src/passes/1-parser/shared/LexerLog.mli

@@ -5,15 +5,22 @@ module type S =
     module Lexer : Lexer.S
 
     val output_token :
-      ?offsets:bool -> [`Byte | `Point] ->
-      EvalOpt.command -> out_channel ->
-      Markup.t list -> Lexer.token -> unit
+      ?offsets:bool ->
+      [`Byte | `Point] ->
+      EvalOpt.command ->
+      out_channel ->
+      Markup.t list ->
+      Lexer.token ->
+      unit
 
     type file_path = string
 
     val trace :
-      ?offsets:bool -> [`Byte | `Point] ->
-      file_path option -> EvalOpt.command ->
+      ?offsets:bool ->
+      [`Byte | `Point] ->
+      EvalOpt.language ->
+      Lexer.input ->
+      EvalOpt.command ->
       (unit, string Region.reg) Stdlib.result
   end
 

src/passes/1-parser/shared/LexerUnit.ml

@@ -1,110 +1,112 @@
-(* Functor to build a standalone LIGO lexer *)
+(* Functor to build a LIGO lexer *)
 
 module Region = Simple_utils.Region
+module Preproc = Preprocessor.Preproc
+module SSet = Set.Make (String)
 
 module type IO =
   sig
-    val ext : string              (* LIGO file extension *)
     val options : EvalOpt.options (* CLI options *)
   end
 
 module Make (IO: IO) (Lexer: Lexer.S) =
   struct
-    open Printf
-    module SSet = Utils.String.Set
-
     (* Error printing and exception tracing *)
 
     let () = Printexc.record_backtrace true
 
-    (*  Preprocessing the input source and opening the input channels *)
-
-    (* Path for CPP inclusions (#include) *)
-
-    let lib_path =
-      match IO.options#libs with
-        [] -> ""
-      | libs -> let mk_I dir path = sprintf " -I %s%s" dir path
-               in List.fold_right mk_I libs ""
-
-    let prefix =
-      match IO.options#input with
-        None | Some "-" -> "temp"
-      | Some file ->  Filename.(file |> basename |> remove_extension)
-
-    let suffix = ".pp" ^ IO.ext
-
-    let pp_input =
-      if Utils.String.Set.mem "cpp" IO.options#verbose
-      then prefix ^ suffix
-      else let pp_input, pp_out = Filename.open_temp_file prefix suffix
-           in close_out pp_out; pp_input
-
-    let cpp_cmd =
-      match IO.options#input with
-        None | Some "-" ->
-          sprintf "cpp -traditional-cpp%s - > %s"
-                  lib_path pp_input
-      | Some file ->
-          sprintf "cpp -traditional-cpp%s %s > %s"
-                  lib_path file pp_input
-
-    (* Running the lexer on the input file *)
+    (* Preprocessing and lexing the input source *)
 
     let scan () : (Lexer.token list, string Region.reg) Stdlib.result =
-      (* Preprocessing the input *)
+      (* Preprocessing the input source *)
 
-      if SSet.mem "cpp" IO.options#verbose
-      then eprintf "%s\n%!" cpp_cmd
-      else ();
+      let preproc cin =
+        let buffer = Lexing.from_channel cin in
+        let open Lexing in
+        let () =
+          match IO.options#input with
+            None -> ()
+          | Some pos_fname ->
+              buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} in
+        let opt = (IO.options :> Preprocessor.EvalOpt.options) in
+        match Preproc.lex opt buffer with
+          Stdlib.Error (pp_buffer, err) ->
+            if SSet.mem "preproc" IO.options#verbose then
+              Printf.printf "%s\n%!" (Buffer.contents pp_buffer);
+            let formatted =
+              Preproc.format ~offsets:IO.options#offsets ~file:true err
+            in Stdlib.Error formatted
+        | Stdlib.Ok pp_buffer ->
+           (* Running the lexer on the preprocessed input *)
 
-      if Sys.command cpp_cmd <> 0 then
-        let msg =
-          sprintf "External error: the command \"%s\" failed." cpp_cmd
-        in Stdlib.Error (Region.wrap_ghost msg)
-      else
-        match Lexer.open_token_stream (Lexer.File pp_input) with
-          Ok Lexer.{read; buffer; close; _} ->
-            let close_all () = close (); close_out stdout in
-            let rec read_tokens tokens =
-              match read ~log:(fun _ _ -> ()) buffer with
-                token ->
-                  if   Lexer.Token.is_eof token
-                  then Stdlib.Ok (List.rev tokens)
-                  else read_tokens (token::tokens)
-              | exception Lexer.Error error ->
-                  let file =
-                    match IO.options#input with
-                      None | Some "-" -> false
-                    |         Some _  -> true in
-                  let msg =
-                    Lexer.format_error ~offsets:IO.options#offsets
-                                       IO.options#mode ~file error
-                  in Stdlib.Error msg in
-            let result = read_tokens []
-            in close_all (); result
-        | Stdlib.Error (Lexer.File_opening msg) ->
-            close_out stdout; Stdlib.Error (Region.wrap_ghost msg)
+            let source = Lexer.String (Buffer.contents pp_buffer) in
+              match Lexer.open_token_stream IO.options#lang source with
+                Ok Lexer.{read; buffer; close; _} ->
+                  let close_all () = flush_all (); close () in
+                  let rec read_tokens tokens =
+                    match read ~log:(fun _ _ -> ()) buffer with
+                      token ->
+                        if   Lexer.Token.is_eof token
+                        then Stdlib.Ok (List.rev tokens)
+                        else read_tokens (token::tokens)
+                    | exception Lexer.Error error ->
+                        let file =
+                          match IO.options#input with
+                            None | Some "-" -> false
+                          |         Some _  -> true in
+                        let () =
+                          Printf.eprintf "[LexerUnit] file = %b\n%!" file in
+                        let msg =
+                          Lexer.format_error ~offsets:IO.options#offsets
+                                             IO.options#mode ~file error
+                        in Stdlib.Error msg in
+                  let result = read_tokens []
+                  in close_all (); result
+              | Stdlib.Error (Lexer.File_opening msg) ->
+                  flush_all (); Stdlib.Error (Region.wrap_ghost msg) in
+      match IO.options#input with
+        None -> preproc stdin
+      | Some file_path ->
+          try open_in file_path |> preproc with
+            Sys_error msg -> Stdlib.Error (Region.wrap_ghost msg)
 
-    (* Tracing the lexing (effectful) *)
+    (* Tracing the lexing *)
 
     module Log = LexerLog.Make (Lexer)
 
     let trace () : (unit, string Region.reg) Stdlib.result =
       (* Preprocessing the input *)
-
-      if SSet.mem "cpp" IO.options#verbose
-      then eprintf "%s\n%!" cpp_cmd
-      else ();
-
-      if Sys.command cpp_cmd <> 0 then
-        let msg =
-          sprintf "External error: the command \"%s\" failed." cpp_cmd
-        in Stdlib.Error (Region.wrap_ghost msg)
-      else
-        Log.trace ~offsets:IO.options#offsets
-                  IO.options#mode
-                  (Some pp_input)
-                  IO.options#cmd
-
+      let preproc cin =
+        let buffer = Lexing.from_channel cin in
+        let open Lexing in
+        let () =
+          match IO.options#input with
+            None | Some "-" -> ()
+          | Some pos_fname ->
+             buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} in
+        let opt = (IO.options :> Preprocessor.EvalOpt.options) in
+        match Preproc.lex opt buffer with
+          Stdlib.Error (pp_buffer, err) ->
+            if SSet.mem "preproc" IO.options#verbose then
+              Printf.printf "%s\n%!" (Buffer.contents pp_buffer);
+            let formatted =
+              Preproc.format ~offsets:IO.options#offsets ~file:true err
+            in Stdlib.Error formatted
+        | Stdlib.Ok pp_buffer ->
+            let preproc_str = Buffer.contents pp_buffer in
+            if SSet.mem "preproc" IO.options#verbose then
+              begin
+                Printf.printf "%s\n%!" (Buffer.contents pp_buffer);
+                Stdlib.Ok ()
+              end
+            else Log.trace ~offsets:IO.options#offsets
+                           IO.options#mode
+                           IO.options#lang
+                           (Lexer.String preproc_str)
+                           IO.options#cmd
+      in match IO.options#input with
+           None -> preproc stdin
+         | Some file_path ->
+             try open_in file_path |> preproc with
+               Sys_error msg -> Stdlib.Error (Region.wrap_ghost msg)
   end

src/passes/1-parser/shared/LexerUnit.mli

@@ -4,7 +4,6 @@ module Region = Simple_utils.Region
 
 module type IO =
   sig
-    val ext : string              (* LIGO file extension *)
     val options : EvalOpt.options (* CLI options *)
   end
 

src/passes/1-parser/shared/ParserAPI.ml

@@ -2,10 +2,15 @@
 
 module Region = Simple_utils.Region
 
+type options = <
+  offsets : bool;
+  mode    : [`Byte | `Point];
+  cmd     : EvalOpt.command
+>
+
 module type IO =
   sig
-    val ext : string              (* LIGO file extension *)
-    val options : EvalOpt.options (* CLI options *)
+    val options : options
   end
 
 module type PARSER =
@@ -50,7 +55,7 @@ module type PARSER =
 
 (* Main functor *)
 
-module Make (IO : IO)
+module Make (IO: IO)
             (Lexer: Lexer.S)
             (Parser: PARSER with type token = Lexer.Token.token)
             (ParErr: sig val message : int -> string end) =
@@ -95,14 +100,15 @@ module Make (IO : IO)
           None ->
             if Lexer.Token.is_eof invalid then ""
             else let invalid_lexeme = Lexer.Token.to_lexeme invalid in
-                 Printf.sprintf ", before \"%s\"" invalid_lexeme
+                 Printf.sprintf ", at \"%s\"" invalid_lexeme
         | Some valid ->
             let valid_lexeme = Lexer.Token.to_lexeme valid in
-            let s = Printf.sprintf ", after \"%s\"" valid_lexeme in
-            if Lexer.Token.is_eof invalid then s
+            if Lexer.Token.is_eof invalid then
+              Printf.sprintf ", after \"%s\"" valid_lexeme
             else
               let invalid_lexeme = Lexer.Token.to_lexeme invalid in
-              Printf.sprintf "%s and before \"%s\"" s invalid_lexeme in
+              Printf.sprintf " at \"%s\", after \"%s\""
+                             invalid_lexeme valid_lexeme in
       let header = header ^ trailer in
       let msg =
         header ^ (if msg = "" then ".\n" else ":\n" ^ msg)
@@ -110,9 +116,9 @@ module Make (IO : IO)
 
     let failure get_win checkpoint =
       let message = ParErr.message (state checkpoint) in
-      let message = if message = "<YOUR SYNTAX ERROR MESSAGE HERE>\n" then 
+      let message = if message = "<YOUR SYNTAX ERROR MESSAGE HERE>\n" then
         (string_of_int (state checkpoint)) ^ ": <syntax error>"
-      else 
+      else
         message
       in
       match get_win () with
@@ -133,20 +139,21 @@ module Make (IO : IO)
     module Incr = Parser.Incremental
 
     module Log = LexerLog.Make (Lexer)
-    let log    = Log.output_token ~offsets:IO.options#offsets
-                                  IO.options#mode IO.options#cmd stdout
+    let log    = Log.output_token
+                   ~offsets:IO.options#offsets
+                   IO.options#mode IO.options#cmd stdout
 
     let incr_contract Lexer.{read; buffer; get_win; close; _} =
       let supplier  = I.lexer_lexbuf_to_supplier (read ~log) buffer
       and failure   = failure get_win in
       let parser    = Incr.contract buffer.Lexing.lex_curr_p in
       let ast       = I.loop_handle success failure supplier parser
-      in close (); ast
+      in flush_all (); close (); ast
 
     let incr_expr Lexer.{read; buffer; get_win; close; _} =
       let supplier   = I.lexer_lexbuf_to_supplier (read ~log) buffer
       and failure    = failure get_win in
       let parser     = Incr.interactive_expr buffer.Lexing.lex_curr_p in
       let expr       = I.loop_handle success failure supplier parser
-      in close (); expr
+      in flush_all (); close (); expr
   end

src/passes/1-parser/shared/ParserAPI.mli

@@ -2,10 +2,15 @@
 
 module Region = Simple_utils.Region
 
+type options = <
+  offsets : bool;
+  mode    : [`Byte | `Point];
+  cmd     : EvalOpt.command
+>
+
 module type IO =
   sig
-    val ext : string              (* LIGO file extension *)
-    val options : EvalOpt.options (* CLI options *)
+    val options : options
   end
 
 (* The signature generated by Menhir with additional type definitions

src/passes/1-parser/shared/ParserUnit.ml

@@ -1,11 +1,26 @@
-(* Functor to build a standalone LIGO parser *)
+(* Functor to build a LIGO parser *)
 
-module Region = Simple_utils.Region
+module Region  = Simple_utils.Region
+module Preproc = Preprocessor.Preproc
+module SSet    = Set.Make (String)
 
-module type IO =
+type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO]
+
+module type SubIO =
   sig
-    val ext : string              (* LIGO file extension *)
-    val options : EvalOpt.options (* CLI options *)
+    type options = <
+      libs    : string list;
+      verbose : SSet.t;
+      offsets : bool;
+      lang    : language;
+      ext     : string;   (* ".ligo", ".mligo", ".religo" *)
+      mode    : [`Byte | `Point];
+      cmd     : EvalOpt.command;
+      mono    : bool
+    >
+
+    val options : options
+    val make : input:string option -> expr:bool -> EvalOpt.options
   end
 
 module type Pretty =
@@ -32,18 +47,18 @@ module Make (Lexer: Lexer.S)
             (ParErr: sig val message : int -> string end)
             (ParserLog: Pretty with type ast  = AST.t
                                 and type expr = AST.expr)
-            (IO: IO) =
+            (SubIO: SubIO) =
   struct
     open Printf
-    module SSet = Utils.String.Set
+    module SSet = Set.Make (String)
 
     (* Log of the lexer *)
 
     module Log = LexerLog.Make (Lexer)
 
     let log =
-      Log.output_token ~offsets:IO.options#offsets
-                       IO.options#mode IO.options#cmd stdout
+      Log.output_token ~offsets:SubIO.options#offsets
+                       SubIO.options#mode SubIO.options#cmd stdout
 
     (* Error handling (reexported from [ParserAPI]) *)
 
@@ -54,7 +69,12 @@ module Make (Lexer: Lexer.S)
 
     (* Instantiating the parser *)
 
-    module Front = ParserAPI.Make (IO)(Lexer)(Parser)(ParErr)
+    module API_IO =
+      struct
+        let options = (SubIO.options :> ParserAPI.options)
+      end
+
+    module Front = ParserAPI.Make (API_IO)(Lexer)(Parser)(ParErr)
 
     let format_error = Front.format_error
 
@@ -67,13 +87,13 @@ module Make (Lexer: Lexer.S)
       (AST.expr, message Region.reg) Stdlib.result =
       let output = Buffer.create 131 in
       let state  =
-        ParserLog.mk_state ~offsets:IO.options#offsets
-                           ~mode:IO.options#mode
+        ParserLog.mk_state ~offsets:SubIO.options#offsets
+                           ~mode:SubIO.options#mode
                            ~buffer:output in
       let close () = lexer_inst.Lexer.close () in
       let expr =
         try
-          if IO.options#mono then
+          if SubIO.options#mono then
             let tokeniser = lexer_inst.Lexer.read ~log
             and lexbuf = lexer_inst.Lexer.buffer
             in Front.mono_expr tokeniser lexbuf
@@ -81,20 +101,20 @@ module Make (Lexer: Lexer.S)
             Front.incr_expr lexer_inst
         with exn -> close (); raise exn in
       let () =
-        if SSet.mem "ast-tokens" IO.options#verbose then
+        if SSet.mem "ast-tokens" SubIO.options#verbose then
           begin
             Buffer.clear output;
             ParserLog.print_expr state expr;
             Buffer.output_buffer stdout output
           end in
       let () =
-        if SSet.mem "ast" IO.options#verbose then
+        if SSet.mem "ast" SubIO.options#verbose then
           begin
             Buffer.clear output;
             ParserLog.pp_expr state expr;
             Buffer.output_buffer stdout output
           end
-      in close (); Ok expr
+      in flush_all (); close (); Ok expr
 
     (* Parsing a contract *)
 
@@ -102,13 +122,13 @@ module Make (Lexer: Lexer.S)
       (AST.t, message Region.reg) Stdlib.result =
       let output = Buffer.create 131 in
       let state  =
-        ParserLog.mk_state ~offsets:IO.options#offsets
-                           ~mode:IO.options#mode
+        ParserLog.mk_state ~offsets:SubIO.options#offsets
+                           ~mode:SubIO.options#mode
                            ~buffer:output in
       let close () = lexer_inst.Lexer.close () in
       let ast =
         try
-          if IO.options#mono then
+          if SubIO.options#mono then
             let tokeniser = lexer_inst.Lexer.read ~log
             and lexbuf = lexer_inst.Lexer.buffer
             in Front.mono_contract tokeniser lexbuf
@@ -116,25 +136,23 @@ module Make (Lexer: Lexer.S)
             Front.incr_contract lexer_inst
         with exn -> close (); raise exn in
       let () =
-        if SSet.mem "ast-tokens" IO.options#verbose then
+        if SSet.mem "ast-tokens" SubIO.options#verbose then
           begin
             Buffer.clear output;
             ParserLog.print_tokens state ast;
             Buffer.output_buffer stdout output
           end in
       let () =
-        if SSet.mem "ast" IO.options#verbose then
+        if SSet.mem "ast" SubIO.options#verbose then
           begin
             Buffer.clear output;
             ParserLog.pp_ast state ast;
             Buffer.output_buffer stdout output
           end
-      in close (); Ok ast
+      in flush_all (); close (); Ok ast
 
     (* Wrapper for the parsers above *)
 
-    type 'a parser = Lexer.instance -> ('a, message Region.reg) result
-
     let apply lexer_inst parser =
       (* Calling the parser and filtering errors *)
 
@@ -146,20 +164,18 @@ module Make (Lexer: Lexer.S)
 
       | exception Lexer.Error err ->
           let file =
-            match IO.options#input with
-              None | Some "-" -> false
-            |          Some _ -> true in
+            lexer_inst.Lexer.buffer.Lexing.lex_curr_p.Lexing.pos_fname in
           let error =
-            Lexer.format_error ~offsets:IO.options#offsets
-                               IO.options#mode err ~file
+            Lexer.format_error ~offsets:SubIO.options#offsets
+                               SubIO.options#mode err ~file:(file <> "")
           in Stdlib.Error error
 
       (* Incremental API of Menhir *)
 
       | exception Front.Point point ->
           let error =
-            Front.format_error ~offsets:IO.options#offsets
-                               IO.options#mode point
+            Front.format_error ~offsets:SubIO.options#offsets
+                               SubIO.options#mode point
           in Stdlib.Error error
 
       (* Monolithic API of Menhir *)
@@ -169,16 +185,106 @@ module Make (Lexer: Lexer.S)
             match lexer_inst.Lexer.get_win () with
               Lexer.Nil ->
                   assert false (* Safe: There is always at least EOF. *)
-              | Lexer.One invalid -> invalid, None
-              | Lexer.Two (invalid, valid) -> invalid, Some valid in
+            | Lexer.One invalid -> invalid, None
+            | Lexer.Two (invalid, valid) -> invalid, Some valid in
             let point = "", valid_opt, invalid in
             let error =
-              Front.format_error ~offsets:IO.options#offsets
-                                 IO.options#mode point
+              Front.format_error ~offsets:SubIO.options#offsets
+                                 SubIO.options#mode point
             in Stdlib.Error error
 
        (* I/O errors *)
 
        | exception Sys_error error ->
-           Stdlib.Error (Region.wrap_ghost error)
+           flush_all (); Stdlib.Error (Region.wrap_ghost error)
+
+    (* Preprocessing the input source *)
+
+    let preproc options lexbuf =
+      Preproc.lex (options :> Preprocessor.EvalOpt.options) lexbuf
+
+    (* Parsing a contract *)
+
+    let gen_parser options input parser =
+      match Lexer.lexbuf_from_input input with
+        Stdlib.Error (Lexer.File_opening msg) ->
+          Stdlib.Error (Region.wrap_ghost msg)
+      | Ok (lexbuf, close) ->
+         (* Preprocessing the input source *)
+         let file = Lexing.(lexbuf.lex_curr_p.pos_fname) in
+         match preproc options lexbuf with
+            Stdlib.Error (pp_buffer, err) ->
+              if SSet.mem "preproc" options#verbose then
+                Printf.printf "%s\n%!" (Buffer.contents pp_buffer);
+              let formatted =
+                Preproc.format ~offsets:options#offsets
+                               ~file:(file <> "")
+                               err
+              in close (); Stdlib.Error formatted
+          | Stdlib.Ok buffer ->
+             (* Lexing and parsing the preprocessed input source *)
+
+             let () = close () in
+             let input' = Lexer.String (Buffer.contents buffer) in
+             match Lexer.open_token_stream options#lang input' with
+               Ok instance ->
+                 let open Lexing in
+                 instance.Lexer.buffer.lex_curr_p <-
+                   {instance.Lexer.buffer.lex_curr_p with pos_fname = file};
+                 apply instance parser
+             | Stdlib.Error (Lexer.File_opening msg) ->
+                 Stdlib.Error (Region.wrap_ghost msg)
+
+    (* Parsing a contract in a file *)
+
+    let contract_in_file (source : string) =
+      let options = SubIO.make ~input:(Some source) ~expr:false
+      in gen_parser options (Lexer.File source) parse_contract
+
+    (* Parsing a contract in a string *)
+
+    let contract_in_string (source : string) =
+      let options = SubIO.make ~input:None ~expr:false in
+      gen_parser options (Lexer.String source) parse_contract
+
+    (* Parsing a contract in stdin *)
+
+    let contract_in_stdin () =
+      let options = SubIO.make ~input:None ~expr:false in
+      gen_parser options (Lexer.Channel stdin) parse_contract
+
+    (* Parsing an expression in a string *)
+
+    let expr_in_string (source : string) =
+      let options = SubIO.make ~input:None ~expr:true in
+      gen_parser options (Lexer.String source) parse_expr
+
+    (* Parsing an expression in stdin *)
+
+    let expr_in_stdin () =
+      let options = SubIO.make ~input:None ~expr:true in
+      gen_parser options (Lexer.Channel stdin) parse_expr
+
+    (* Preprocess only *)
+
+    let preprocess (source : string) =
+      let options = SubIO.make ~input:(Some source) ~expr:false in
+      try
+        let cin     = open_in source in
+        let lexbuf  = Lexing.from_channel cin in
+        let () =
+          let open Lexing in
+          lexbuf.lex_curr_p <- {lexbuf.lex_curr_p with pos_fname=source}
+        and options = (options :> Preprocessor.EvalOpt.options) in
+        match Preprocessor.Preproc.lex options lexbuf with
+          Stdlib.Ok _ as ok  -> ok
+        | Error (_, err) ->
+            let formatted =
+              Preproc.format ~offsets:options#offsets
+                             ~file:true
+                             err
+            in close_in cin; Stdlib.Error formatted
+      with Sys_error error ->
+             flush_all (); Stdlib.Error (Region.wrap_ghost error)
+
   end

src/passes/1-parser/shared/ParserUnit.mli

@@ -2,10 +2,25 @@
 
 module Region = Simple_utils.Region
 
-module type IO =
+type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO]
+
+module SSet : Set.S with type elt = string and type t = Set.Make(String).t
+
+module type SubIO =
   sig
-    val ext : string              (* LIGO file extension *)
-    val options : EvalOpt.options (* CLI options *)
+    type options = <
+      libs    : string list;
+      verbose : SSet.t;
+      offsets : bool;
+      lang    : language;
+      ext     : string;   (* ".ligo", ".mligo", ".religo" *)
+      mode    : [`Byte | `Point];
+      cmd     : EvalOpt.command;
+      mono    : bool
+    >
+
+    val options : options
+    val make : input:string option -> expr:bool -> EvalOpt.options
   end
 
 module type Pretty =
@@ -32,7 +47,7 @@ module Make (Lexer : Lexer.S)
             (ParErr : sig val message : int -> string end)
             (ParserLog : Pretty with type ast  = AST.t
                                  and type expr = AST.expr)
-            (IO: IO) :
+            (SubIO: SubIO) :
   sig
     (* Error handling reexported from [ParserAPI] without the
        exception [Point] *)
@@ -50,10 +65,21 @@ module Make (Lexer : Lexer.S)
 
     (* Parsers *)
 
-    type 'a parser = Lexer.instance -> ('a, message Region.reg) result
+    val contract_in_file :
+      string -> (AST.t, message Region.reg) Stdlib.result
 
-    val apply : Lexer.instance -> 'a parser -> ('a, message Region.reg) result
+    val contract_in_string :
+      string -> (AST.t, message Region.reg) Stdlib.result
 
-    val parse_contract : AST.t parser
-    val parse_expr     : AST.expr parser
-  end
+    val contract_in_stdin :
+      unit -> (AST.t, message Region.reg) Stdlib.result
+
+    val expr_in_string :
+      string -> (AST.expr, message Region.reg) Stdlib.result
+
+    val expr_in_stdin :
+      unit -> (AST.expr, message Region.reg) Stdlib.result
+
+    val preprocess :
+      string -> (Buffer.t, message Region.reg) Stdlib.result
+end

src/passes/1-parser/shared/dune

@@ -8,7 +8,8 @@
     simple-utils
     uutf
     getopt
-    zarith)
+    zarith
+    Preprocessor)
   (preprocess
     (pps bisect_ppx --conditional))
   (modules
@@ -17,8 +18,8 @@
     ParserAPI
     Lexer
     LexerLog
-    Utils
     Markup
+    Utils
     FQueue
     EvalOpt
     Version))

src/passes/2-concrete_to_imperative/cameligo.ml

@@ -120,7 +120,7 @@ module Errors = struct
     let data = [
         ("expression" ,
          (** TODO: The labelled arguments should be flowing from the CLI. *)
-       thunk @@ Parser.Cameligo.ParserLog.expr_to_string
+       thunk @@ Parser_cameligo.ParserLog.expr_to_string
                  ~offsets:true ~mode:`Point t)]
     in error ~data title message
 
@@ -204,7 +204,7 @@ let rec typed_pattern_to_typed_vars : Raw.pattern -> _ = fun pattern ->
   | Raw.PPar pp -> typed_pattern_to_typed_vars pp.value.inside
   | Raw.PTyped pt ->
      let (p,t) = pt.value.pattern,pt.value.type_expr in
-     let%bind p = tuple_pattern_to_vars p in 
+     let%bind p = tuple_pattern_to_vars p in
      let%bind t = compile_type_expression t in
      ok @@ (p,t)
   | other -> (fail @@ wrong_pattern "parenthetical or type annotation" other)
@@ -320,7 +320,7 @@ let rec compile_expression :
     | [] -> e_variable (Var.of_name name)
     | _ ->
       let aux expr (Label l) = e_record_accessor expr l in
-      List.fold_left aux (e_variable (Var.of_name name)) path in 
+      List.fold_left aux (e_variable (Var.of_name name)) path in
     let updates = u.updates.value.ne_elements in
     let%bind updates' =
       let aux (f:Raw.field_path_assign Raw.reg) =
@@ -330,13 +330,13 @@ let rec compile_expression :
       in
       bind_map_list aux @@ npseq_to_list updates
     in
-    let aux ur (path, expr) = 
+    let aux ur (path, expr) =
       let rec aux record = function
         | [] -> failwith "error in parsing"
         | hd :: [] -> ok @@ e_record_update ~loc record hd expr
-        | hd :: tl -> 
+        | hd :: tl ->
           let%bind expr = (aux (e_record_accessor ~loc record hd) tl) in
-          ok @@ e_record_update ~loc record hd expr 
+          ok @@ e_record_update ~loc record hd expr
       in
       aux ur path in
     bind_fold_list aux record updates'
@@ -392,9 +392,9 @@ let rec compile_expression :
           (chain_let_in tl body)
         | [] -> body (* Precluded by corner case assertion above *)
       in
-      let%bind ty_opt = match ty_opt with 
-      | None -> (match let_rhs with 
-        | EFun {value={binders;lhs_type}} -> 
+      let%bind ty_opt = match ty_opt with
+      | None -> (match let_rhs with
+        | EFun {value={binders;lhs_type}} ->
           let f_args = nseq_to_list (binders) in
           let%bind lhs_type' = bind_map_option (fun x -> compile_type_expression (snd x)) lhs_type in
           let%bind ty = bind_map_list typed_pattern_to_typed_vars f_args in
@@ -409,12 +409,12 @@ let rec compile_expression :
         (* Bind the right hand side so we only evaluate it once *)
         else ok (e_let_in (rhs_b, ty_opt) inline rhs' (chain_let_in prep_vars body))
       in
-      let%bind ret_expr = match kwd_rec with 
+      let%bind ret_expr = match kwd_rec with
         | None -> ok @@ ret_expr
-        | Some _ -> 
-          match ret_expr.expression_content with 
+        | Some _ ->
+          match ret_expr.expression_content with
             | E_let_in li -> (
-              let%bind lambda = 
+              let%bind lambda =
                 let rec aux rhs = match rhs.expression_content with
                   | E_lambda l -> ok @@ l
                   | E_ascription a -> aux a.anno_expr
@@ -423,9 +423,9 @@ let rec compile_expression :
                 aux rhs'
               in
               let fun_name = fst @@ List.hd prep_vars in
-              let%bind fun_type = match ty_opt with 
+              let%bind fun_type = match ty_opt with
                 | Some t -> ok @@ t
-                | None -> match rhs'.expression_content with 
+                | None -> match rhs'.expression_content with
                       | E_ascription a -> ok a.type_annotation
                       | _ -> fail @@ untyped_recursive_function e
               in
@@ -878,9 +878,9 @@ and compile_declaration : Raw.declaration -> declaration Location.wrap list resu
           ok (Raw.EFun {region=Region.ghost ; value=fun_},List.fold_right' aux lhs_type' ty)
       in
       let%bind rhs' = compile_expression let_rhs in
-      let%bind lhs_type = match lhs_type with 
-      | None -> (match let_rhs with 
-        | EFun {value={binders;lhs_type}} -> 
+      let%bind lhs_type = match lhs_type with
+      | None -> (match let_rhs with
+        | EFun {value={binders;lhs_type}} ->
           let f_args = nseq_to_list (binders) in
           let%bind lhs_type' = bind_map_option (fun x -> compile_type_expression (snd x)) lhs_type in
           let%bind ty = bind_map_list typed_pattern_to_typed_vars f_args in
@@ -891,13 +891,13 @@ and compile_declaration : Raw.declaration -> declaration Location.wrap list resu
       | Some t -> ok @@ Some t
       in
       let binder = Var.of_name var.value in
-      let%bind rhs' = match recursive with 
-        None -> ok @@ rhs' 
-        | Some _ -> match rhs'.expression_content with 
+      let%bind rhs' = match recursive with
+        None -> ok @@ rhs'
+        | Some _ -> match rhs'.expression_content with
           E_lambda lambda ->
-            (match lhs_type with 
-              None -> fail @@ untyped_recursive_function var 
-              | Some (lhs_type) -> 
+            (match lhs_type with
+              None -> fail @@ untyped_recursive_function var
+              | Some (lhs_type) ->
               let expression_content = E_recursive {fun_name=binder;fun_type=lhs_type;lambda} in
               ok @@ {rhs' with expression_content})
           | _ -> ok @@ rhs'
@@ -996,7 +996,7 @@ and compile_cases : type a . (Raw.pattern * a) list -> (a, unit) matching_conten
          (** TODO: The labelled arguments should be flowing from the CLI. *)
         let content () =
           Printf.sprintf "Pattern : %s"
-                         (Parser.Cameligo.ParserLog.pattern_to_string
+                         (Parser_cameligo.ParserLog.pattern_to_string
                             ~offsets:true ~mode:`Point x) in
         error title content
       in

src/test/contracts/pledge.religo

@@ -1,14 +1,14 @@
-(* Pledge-Distribute — Accept money from a number of contributors and then donate
-   to an address designated by an oracle *)
+/* Pledge-Distribute — Accept money from a number of contributors and then donate
+   to an address designated by an oracle */
 
-(* A lot of people (myself included) seem to expect an oracle to be more than it is.
+/* A lot of people (myself included) seem to expect an oracle to be more than it is.
    That is, they expect it to be something complicated when it's actually pretty simple.
    An oracle is just an authorized source of information external to the chain, like an
    arbiter or moderator. For example, it's not possible to do an HTTP request to get
    info from a weather site directly using a smart contract. So instead what you
    do is make (or use) an oracle service which uploads the data to the chain so
    that contracts can use it.
-*)
+*/
 
 type storage = address
 

src/test/contracts/website2.religo

@@ -1,4 +1,4 @@
-(* IF YOU CHANGE THIS, CHANGE THE EXAMPLE ON THE FRONT PAGE OF THE WEBSITE *)
+/* IF YOU CHANGE THIS, CHANGE THE EXAMPLE ON THE FRONT PAGE OF THE WEBSITE */
 
 type storage = int;
 
@@ -22,4 +22,4 @@ let main = ((p,storage): (parameter, storage)) => {
   ([]: list (operation), storage);
 };
 
-(* IF YOU CHANGE THIS, CHANGE THE EXAMPLE ON THE FRONT PAGE OF THE WEBSITE *)
+/* IF YOU CHANGE THIS, CHANGE THE EXAMPLE ON THE FRONT PAGE OF THE WEBSITE */

vendors/Preproc/EMain.ml

@@ -1,33 +0,0 @@
-(* This module is only used for testing modules [Escan] and [Eparser]
-   as units *)
-
-module Lexer = struct
-  let run () =
-    match Array.length Sys.argv with
-      2 -> Escan.trace Sys.argv.(1)
-    | _ -> prerr_endline ("Usage: " ^ Sys.argv.(0) ^ " [file]")
-end
-
-module Parser = struct
-  let run () =
-    if Array.length Sys.argv = 2
-    then
-      match open_in Sys.argv.(1) with
-        exception Sys_error msg -> prerr_endline msg
-      | cin ->
-          let buffer = Lexing.from_channel cin in
-          let open Error in
-          let () =
-            try
-              let tree = Eparser.pp_expression Escan.token buffer in
-              let value = Preproc.(eval Env.empty tree)
-              in (print_string (string_of_bool value);
-                  print_newline ())
-            with Lexer diag    -> print "Lexical" diag
-               | Parser diag   -> print "Syntactical" diag
-               | Eparser.Error -> print "" ("Parse", mk_seg buffer, 1)
-          in close_in cin
-    else prerr_endline ("Usage: " ^ Sys.argv.(0) ^ " [file]")
-end
-
-let _ = Parser.run()

vendors/Preproc/Eparser.mly

@@ -1,50 +0,0 @@
-%{
-(* Grammar for boolean expressions in preprocessing directives of C# *)
-%}
-
-%token True False
-%token <string> Ident
-%token OR AND EQ NEQ NOT EOL LPAR RPAR
-
-(* Entries *)
-
-%start pp_expression
-%type <Etree.t> pp_expression
-
-%%
-
-(* Grammar *)
-
-pp_expression:
-  e=pp_or_expression EOL { e }
-
-pp_or_expression:
-  e=pp_and_expression { e }
-| e1=pp_or_expression OR e2=pp_and_expression {
-    Etree.Or (e1,e2)
-  }
-
-pp_and_expression:
-  e=pp_equality_expression { e }
-| e1=pp_and_expression AND e2=pp_unary_expression {
-    Etree.And (e1,e2)
-  }
-
-pp_equality_expression:
-  e=pp_unary_expression { e }
-| e1=pp_equality_expression EQ e2=pp_unary_expression {
-    Etree.Eq (e1,e2)
-  }
-| e1=pp_equality_expression NEQ e2=pp_unary_expression {
-    Etree.Neq (e1,e2)
-  }
-
-pp_unary_expression:
-  e=pp_primary_expression   { e           }
-| NOT e=pp_unary_expression { Etree.Not e }
-
-pp_primary_expression:
-  True                         { Etree.True     }
-| False                        { Etree.False    }
-| id=Ident                     { Etree.Ident id }
-| LPAR e=pp_or_expression RPAR { e              }

vendors/Preproc/Error.ml

@@ -1,31 +0,0 @@
-(* This module provides support for managing and printing errors when
-   preprocessing C# source files. *)
-
-type message = string
-type start = Lexing.position
-type stop = Lexing.position
-type seg = start * stop
-
-let mk_seg buffer =
-  Lexing.(lexeme_start_p buffer, lexeme_end_p buffer)
-
-type vline = int
-
-exception Lexer of (message * seg * vline)
-exception Parser of (message * seg * vline)
-
-let print (kind: string) (msg, (start, stop), vend) =
-  let open Lexing in
-  let delta = vend - stop.pos_lnum in
-  let vstart = start.pos_lnum + delta
-in assert (msg <> "");
-   prerr_endline
-   ((if kind = "" then msg else kind) ^ " error at line "
-    ^ string_of_int vstart ^ ", char " 
-    ^ string_of_int (start.pos_cnum - start.pos_bol) 
-    ^ (if stop.pos_lnum = start.pos_lnum
-       then "--" ^ string_of_int (stop.pos_cnum - stop.pos_bol)
-       else " to line " ^ string_of_int vend
-            ^ ", char "
-            ^ string_of_int (stop.pos_cnum - stop.pos_bol))
-    ^ (if kind = "" then "." else ":\n" ^ msg))

vendors/Preproc/Escan.mll

@@ -1,95 +0,0 @@
-{
-(* Auxiliary scanner for boolean expressions of the C# preprocessor *)
-
-(* Concrete syntax of tokens. See module [Eparser]. *)
-
-let string_of_token =
-  let open Eparser
-in function True -> "true"
-      |    False -> "false"
-      | Ident id -> id
-      |       OR -> "||"
-      |      AND -> "&&"
-      |       EQ -> "=="
-      |      NEQ -> "!="
-      |      NOT -> "!"
-      |     LPAR -> "("
-      |     RPAR -> ")"
-      |      EOL -> "EOL"
-
-}
-
-(* Regular expressions for literals *)
-
-(* White space *)
-
-let newline = '\n' | '\r' | "\r\n"
-let blank = ' ' | '\t'
-
-(* Unicode escape sequences *)
-
-let digit = ['0'-'9']
-let hexdigit = digit | ['A'-'F' 'a'-'f']
-let four_hex = hexdigit hexdigit hexdigit hexdigit
-let uni_esc = "\\u" four_hex | "\\U"  four_hex four_hex
-
-(* Identifiers *)
-
-let lowercase = ['a'-'z']
-let uppercase = ['A'-'Z']
-let letter = lowercase | uppercase | uni_esc
-let start = '_' | letter
-let alphanum = letter | digit | '_'
-let ident = start alphanum*
-
-(* Rules *)
-
-rule token = parse
-  blank+      { token lexbuf      }
-| newline     { Lexing.new_line lexbuf; Eparser.EOL }
-| eof         { Eparser.EOL       }
-| "true"      { Eparser.True      }
-| "false"     { Eparser.False     }
-| ident as id { Eparser.Ident id  }
-| '('         { Eparser.LPAR      }
-| ')'         { Eparser.RPAR      }
-| "||"        { Eparser.OR        }
-| "&&"        { Eparser.AND       }
-| "=="        { Eparser.EQ        }
-| "!="        { Eparser.NEQ       }
-| "!"         { Eparser.NOT       }
-| "//"        { inline_com lexbuf }
-| _ as c      { let code = Char.code c in
-                let msg = "Invalid character " ^ String.make 1 c
-                          ^ " (" ^ string_of_int code ^ ")."
-                in raise Error.(Lexer (msg, mk_seg lexbuf, 1))
-              }
-
-and inline_com = parse
-  newline { Lexing.new_line lexbuf; Eparser.EOL }
-| eof     { Eparser.EOL }
-| _       { inline_com lexbuf }
-
-{
-(* Standalone lexer for debugging purposes. See module [Topexp]. *)
-
-type filename = string
-
-let trace (name: filename) =
-  match open_in name with
-    cin ->
-      let buffer = Lexing.from_channel cin
-      and cout = stdout in
-      let rec iter () =
-        match token buffer with
-          Eparser.EOL -> close_in cin; close_out cout
-        |           t -> begin
-                          output_string cout (string_of_token t);
-                          output_string cout "\n";
-                          flush cout;
-                          iter ()
-                        end
-        | exception Error.Lexer diag -> Error.print "Lexical" diag
-      in iter ()
-  | exception Sys_error msg -> prerr_endline msg
-}

vendors/Preproc/Preproc.mll

@@ -1,585 +0,0 @@
-(* Preprocessor for C#, to be processed by [ocamllex]. *)
-
-{
-(* STRING PROCESSING *)
-
-(* The value of [mk_str len p] ("make string") is a string of length
-   [len] containing the [len] characters in the list [p], in reverse
-   order. For instance, [mk_str 3 ['c';'b';'a'] = "abc"]. *)
-
- let mk_str (len: int) (p: char list) : string =
-  let () = assert (len = List.length p) in
-  let bytes = Bytes.make len ' ' in
-  let rec fill i = function
-         [] -> bytes
-  | char::l -> Bytes.set bytes i char; fill (i-1) l
-  in fill (len-1) p |> Bytes.to_string
-
-(* 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']]. *)
-
-let explode s acc =
-  let rec push = function
-    0 -> acc
-  | i -> s.[i-1] :: push (i-1)
-in push (String.length s)
-
-(* ERROR HANDLING *)
-
-let stop msg seg = raise (Error.Lexer (msg, seg,1))
-let fail msg buffer = stop msg (Error.mk_seg buffer)
-
-exception Local_err of Error.message
-
-let handle_err scan buffer =
-  try scan buffer with Local_err msg -> fail msg buffer
-
-(* LEXING ENGINE *)
-
-(* Copying the current lexeme to [stdout] *)
-
-let copy buffer = print_string (Lexing.lexeme buffer)
-
-(* End of lines *)
-
-let handle_nl buffer = Lexing.new_line buffer; copy buffer
-
-
-(* C# PREPROCESSOR DIRECTIVES *)
-
-(* The type [mode] defines the two scanning modes of the preprocessor:
-   either we copy the current characters or we skip them. *)
-
-type mode = Copy | Skip
-
-(* Trace of directives
-
-   We keep track of directives #if, #elif, #else, #region and #endregion.
-*)
-
-type cond = If of mode | Elif of mode | Else | Region
-type trace = cond list
-
-(* The function [reduce_cond] is called when a #endif directive is
-   found, and the trace (see type [trace] above) needs updating. *)
-
-let rec reduce_cond seg = function
-              [] -> stop "Dangling #endif." seg
-| If mode::trace -> trace, mode
-|      Region::_ -> stop "Invalid scoping of #region" seg
-|       _::trace -> reduce_cond seg trace
-
-(* The function [reduce_reg] is called when a #endregion directive is
-   read, and the trace needs updating. *)
-
-let reduce_reg seg = function
-             [] -> stop "Dangling #endregion." seg
-| Region::trace -> trace
-|             _ -> stop "Invalid scoping of #endregion" seg
-
-(* The function [extend] is called when encountering conditional
-   directives #if, #else and #elif. As its name suggests, it extends
-   the current trace with the current conditional directive, whilst
-   performing some validity checks. *)
-
-let extend seg cond trace =
-  match cond, trace with
-    If _, Elif _::_ ->
-      stop "Directive #if cannot follow #elif." seg
-  | Else,   Else::_ ->
-      stop "Directive #else cannot follow #else." seg
-  | Else,        [] ->
-      stop "Dangling #else." seg
-  | Elif _, Else::_ ->
-      stop "Directive #elif cannot follow #else." seg
-  | Elif _,      [] ->
-      stop "Dangling #elif." seg
-  |               _ -> cond::trace
-
-(* The function [last_mode] seeks the last mode as recorded in the
-   trace (see type [trace] above). *)
-
-let rec last_mode = function
-                        [] -> assert false
-| (If mode | Elif mode)::_ -> mode
-|                 _::trace -> last_mode trace
-
-(* Line offsets
-
-   The value [Inline] of type [offset] means that the current location
-   cannot be reached from the start of the line with only white
-   space. The same holds for the special value [Prefix 0]. Values of
-   the form [Prefix n] mean that the current location can be reached
-   from the start of the line with [n] white spaces (padding). These
-   distinctions are needed because preprocessor directives cannot
-   occur inside lines.
-*)
-
-type offset = Prefix of int | Inline
-
-let expand = function
-  Prefix 0 | Inline -> ()
-| Prefix n -> print_string (String.make n ' ')
-
-(* Directives *)
-
-let directives = [
-  "if"; "else"; "elif"; "endif"; "define"; "undef";
-  "error"; "warning"; "line"; "region"; "endregion";
-  "include"]
-
-(* Environments and preprocessor expressions
-
-   The evaluation of conditional directives may involve symbols whose
-   value may be defined using #define directives, or undefined by
-   means of #undef. Therefore, we need to evaluate conditional
-   expressions in an environment made of a set of defined symbols.
-
-   Note that we rely on an external lexer and parser for the
-   conditional expressions. See modules [Escan] and [Eparser].
-*)
-
-module Env = Set.Make(String)
-
-let rec eval env =
-  let open Etree
-in function
-   Or (e1,e2) -> eval env e1 || eval env e2
-| And (e1,e2) -> eval env e1 && eval env e2
-|  Eq (e1,e2) -> eval env e1 = eval env e2
-| Neq (e1,e2) -> eval env e1 != eval env e2
-|       Not e -> not (eval env e)
-|        True -> true
-|       False -> false
-|    Ident id -> Env.mem id env
-
-let expr env buffer =
-  let tree = Eparser.pp_expression Escan.token buffer
-in if eval env tree then Copy else Skip
-
-(* END OF HEADER *)
-}
-
-(* REGULAR EXPRESSIONS *)
-
-(* White space *)
-
-let nl = '\n' | '\r' | "\r\n"
-let blank = ' ' | '\t'
-
-(* Integers *)
-
-let int_suf = 'U' | 'u' | 'L' | 'l' | "UL" | "Ul" | "uL"
-            | "ul" | "LU" | "Lu" | "lU" | "lu"
-let digit = ['0'-'9']
-let dec = digit+ int_suf?
-let hexdigit = digit | ['A'-'F' 'a'-'f']
-let hex_pre = "0x" | "0X"
-let hexa = hex_pre hexdigit+ int_suf?
-let integer = dec | hexa
-
-(* Unicode escape sequences *)
-
-let four_hex = hexdigit hexdigit hexdigit hexdigit
-let uni_esc = "\\u" four_hex | "\\U"  four_hex four_hex
-
-(* Identifiers *)
-
-let lowercase = ['a'-'z']
-let uppercase = ['A'-'Z']
-let letter = lowercase | uppercase | uni_esc
-let start = '_' | letter
-let alphanum = letter | digit | '_'
-let ident = start alphanum*
-
-(* Real *)
-
-let decimal = digit+
-let exponent = ['e' 'E'] ['+' '-']? decimal
-let real_suf = ['F' 'f' 'D' 'd' 'M' 'm']
-let real = (decimal? '.')? decimal exponent? real_suf?
-
-(* Characters *)
-
-let single = [^ '\n' '\r']
-let esc = "\\'" | "\\\"" | "\\\\" | "\\0" | "\\a" | "\\b" | "\\f"
-        | "\\n" | "\\r" | "\\t" | "\\v"
-let hex_esc = "\\x" hexdigit hexdigit? hexdigit? hexdigit?
-let character = single | esc | hex_esc | uni_esc
-let char = "'" character "'"
-
-(* Directives *)
-
-let directive = '#' (blank* as space) (ident as id)
-
-(* Rules *)
-
-(* The rule [scan] scans the input buffer for directives, strings,
-   comments, blanks, new lines and end of file characters. As a
-   result, either the matched input is copied to [stdout] or not,
-   depending on the compilation directives. If not copied, new line
-   characters are output.
-
-   Scanning is triggered by the function call [scan env mode offset
-   trace lexbuf], where [env] is the set of defined symbols
-   (introduced by `#define'), [mode] specifies whether we are copying
-   or skipping the input, [offset] informs about the location in the
-   line (either there is a prefix of blanks, or at least a non-blank
-   character has been read), and [trace] is the stack of conditional
-   directives read so far.
-
-   The first call is [scan Env.empty Copy (Prefix 0) []], meaning that
-   we start with an empty environment, that copying the input is
-   enabled by default, and that we are at the start of a line and no
-   previous conditional directives have been read yet.
-
-   When an "#if" is matched, the trace is extended by the call [extend
-   lexbuf (If mode) trace], during the evaluation of which the
-   syntactic validity of having encountered an "#if" is checked (for
-   example, it would be invalid had an "#elif" been last read). Note
-   that the current mode is stored in the trace with the current
-   directive -- that mode may be later restored (see below for some
-   examples). Moreover, the directive would be deemed invalid if its
-   current position in the line (that is, its offset) were not
-   preceeded by blanks or nothing, otherwise the rule [expr] is called
-   to scan the boolean expression associated with the "#if": if it
-   evaluates to [true], the result is [Copy], meaning that we may copy
-   what follows, otherwise skip it -- the actual decision depending on
-   the current mode. That new mode is used if we were in copy mode,
-   and the offset is reset to the start of a new line (as we read a
-   new line in [expr]); otherwise we were in skipping mode and the
-   value of the conditional expression must be ignored (but not its
-   syntax), and we continue skipping the input.
-
-   When an "#else" is matched, the trace is extended with [Else],
-   then, if the directive is not at a wrong offset, the rest of the
-   line is scanned with [pp_newline]. If we were in copy mode, the new
-   mode toggles to skipping mode; otherwise, the trace is searched for
-   the last encountered "#if" of "#elif" and the associated mode is
-   restored.
-
-   The case "#elif" is the result of the fusion (in the technical
-   sense) of the code for dealing with an "#else" followed by an
-   "#if".
-
-   When an "#endif" is matched, the trace is reduced, that is, all
-   conditional directives are popped until an [If mode'] is found and
-   [mode'] is restored as the current mode.
-
-   Consider the following four cases, where the modes (Copy/Skip) are
-   located between the lines:
-
-                    Copy ----+                          Copy ----+
-   #if true                  |       #if true                    |
-                    Copy     |                          Copy     |
-   #else                     |       #else                       |
-                +-- Skip --+ |                      +-- Skip --+ |
-     #if true   |          | |         #if false    |          | |
-                |   Skip   | |                      |   Skip   | |
-     #else      |          | |         #else        |          | |
-                +-> Skip   | |                      +-> Skip   | |
-     #endif                | |         #endif                  | |
-                    Skip <-+ |                          Skip <-+ |
-   #endif                    |       #endif                      |
-                    Copy <---+                          Copy <---+
-
-
-                +-- Copy ----+                          Copy --+-+
-   #if false    |            |       #if false                 | |
-                |   Skip     |                          Skip   | |
-   #else        |            |       #else                     | |
-                +-> Copy --+ |                    +-+-- Copy <-+ |
-     #if true              | |         #if false  | |            |
-                    Copy   | |                    | |   Skip     |
-     #else                 | |         #else      | |            |
-                    Skip   | |                    | +-> Copy     |
-     #endif                | |         #endif     |              |
-                    Copy <-+ |                    +---> Copy     |
-   #endif                    |       #endif                      |
-                    Copy <---+                          Copy <---+
-
-   The following four cases feature #elif. Note that we put between
-   brackets the mode saved for the #elif, which is sometimes restored
-   later.
-
-                    Copy --+                            Copy --+
-   #if true                |         #if true                  |
-                    Copy   |                            Copy   |
-   #elif true   +--[Skip]  |         #elif false    +--[Skip]  |
-                |   Skip   |                        |   Skip   |
-   #else        |          |         #else          |          |
-                +-> Skip   |                        +-> Skip   |
-   #endif                  |         #endif                    |
-                    Copy <-+                            Copy <-+
-
-
-                +-- Copy --+-+                      +-- Copy ----+
-   #if false    |          | |       #if false      |            |
-                |   Skip   | |                      |   Skip     |
-   #elif true   +->[Copy]  | |       #elif false    +->[Copy]--+ |
-                    Copy <-+ |                          Skip   | |
-   #else                     |       #else                     | |
-                    Skip     |                          Copy <-+ |
-   #endif                    |       #endif                      |
-                    Copy <---+                          Copy <---+
-
-   Note how "#elif" indeed behaves like an "#else" followed by an
-   "#if", and the mode stored with the data constructor [Elif]
-   corresponds to the mode before the virtual "#if".
-
-   Important note: Comments and strings are recognised as such only in
-   copy mode, which is a different behaviour from the preprocessor of
-   GNU GCC, which always does.
-*)
-
-rule scan env mode offset trace = parse
-  nl    { handle_nl lexbuf;
-          scan env mode (Prefix 0) trace lexbuf }
-| blank { match offset with
-            Prefix n -> scan env mode (Prefix (n+1)) trace lexbuf
-          |   Inline -> copy lexbuf;
-                        scan env mode Inline trace lexbuf }
-| directive {
-    if   not (List.mem id directives)
-    then fail "Invalid preprocessing directive." lexbuf
-    else if   offset = Inline
-         then fail "Directive invalid inside line." lexbuf
-         else let seg = Error.mk_seg lexbuf in
-    match id with
-      "include" ->
-        let curr_line = Lexing.(lexbuf.lex_curr_p.pos_lnum)
-        and curr_file = Lexing.(lexbuf.lex_curr_p.pos_fname)
-                        |> Filename.basename
-        and incl_file = scan_inclusion lexbuf in
-        let incl_buffer =
-          open_in incl_file |> Lexing.from_channel in
-        Printf.printf "# 1 \"%s\" 1\n" incl_file;
-        cat incl_buffer;
-        Printf.printf "# %i \"%s\" 2\n" (curr_line+1) curr_file;
-        scan env mode offset trace lexbuf
-    | "if" ->
-        let mode' = expr env lexbuf in
-        let new_mode = if mode = Copy then mode' else Skip in
-        let trace' = extend seg (If mode) trace
-        in scan env new_mode (Prefix 0) trace' lexbuf
-    | "else" ->
-        let () = pp_newline lexbuf in
-        let new_mode =
-          if mode = Copy then Skip else last_mode trace in
-        let trace' = extend seg Else trace
-        in scan env new_mode (Prefix 0) trace' lexbuf
-    | "elif" ->
-        let mode' = expr env lexbuf in
-        let trace', new_mode =
-          match mode with
-            Copy -> extend seg (Elif Skip) trace, Skip
-          | Skip -> let old_mode = last_mode trace
-                    in extend seg (Elif old_mode) trace,
-                       if old_mode = Copy then mode' else Skip
-        in scan env new_mode (Prefix 0) trace' lexbuf
-    | "endif" ->
-        let () = pp_newline lexbuf in
-        let trace', new_mode = reduce_cond seg trace
-        in scan env new_mode (Prefix 0) trace' lexbuf
-    | "define" ->
-        let id, seg = ident env lexbuf
-        in if id="true" || id="false"
-           then let msg = "Symbol \"" ^ id ^ "\" cannot be defined."
-                in stop msg seg
-           else if Env.mem id env
-                then let msg = "Symbol \"" ^ id
-                               ^ "\" was already defined."
-                     in stop msg seg
-                else scan (Env.add id env) mode (Prefix 0) trace lexbuf
-    | "undef" ->
-        let id, _ = ident env lexbuf
-        in scan (Env.remove id env) mode (Prefix 0) trace lexbuf
-    | "error" ->
-        stop (message [] lexbuf) seg
-    | "warning" ->
-        let start_p, end_p = seg in
-        let msg = message [] lexbuf in
-        let open Lexing
-        in prerr_endline
-             ("Warning at line " ^ string_of_int start_p.pos_lnum
-             ^ ", char "
-             ^ string_of_int (start_p.pos_cnum - start_p.pos_bol)
-             ^ "--" ^ string_of_int (end_p.pos_cnum - end_p.pos_bol)
-             ^ ":\n" ^ msg);
-           scan env mode (Prefix 0) trace lexbuf
-    | "region" ->
-        let msg = message [] lexbuf
-        in expand offset;
-           print_endline ("#" ^ space ^ "region" ^ msg);
-           scan env mode (Prefix 0) (Region::trace) lexbuf
-    | "endregion" ->
-        let msg = message [] lexbuf
-        in expand offset;
-           print_endline ("#" ^ space ^ "endregion" ^ msg);
-           scan env mode (Prefix 0) (reduce_reg seg trace) lexbuf
-    | "line" ->
-        expand offset;
-        print_string ("#" ^ space ^ "line");
-        line_ind lexbuf;
-        scan env mode (Prefix 0) trace lexbuf
-    | _ -> assert false
-  }
-| eof   { match trace with
-            [] -> expand offset; flush stdout; (env, trace)
-          |  _ -> fail "Missing #endif." lexbuf }
-| '"'   { if mode = Copy then begin
-             expand offset; copy lexbuf;
-             handle_err in_norm_str lexbuf
-          end;
-          scan env mode Inline trace lexbuf }
-| "@\"" { if mode = Copy then begin
-             expand offset; copy lexbuf;
-             handle_err in_verb_str lexbuf
-          end;
-          scan env mode Inline trace lexbuf }
-| "//"  { if mode = Copy then begin
-             expand offset; copy lexbuf;
-             in_line_com mode lexbuf
-          end;
-          scan env mode Inline trace lexbuf }
-| "/*"  { if mode = Copy then begin
-             expand offset; copy lexbuf;
-             handle_err in_block_com lexbuf
-          end;
-          scan env mode Inline trace lexbuf }
-| _     { if mode = Copy then (expand offset; copy lexbuf);
-          scan env mode Inline trace lexbuf }
-
-(* Support for #define and #undef *)
-
-and ident env = parse
-  blank* { let r = __ident env lexbuf
-           in pp_newline lexbuf; r }
-
-and __ident env = parse
-  ident as id { id, Error.mk_seg lexbuf }
-
-(* Line indicator (#line) *)
-
-and line_ind = parse
-  blank* as space { print_string space; line_indicator lexbuf }
-
-and line_indicator = parse
-  decimal as ind {
-    print_string ind;
-    end_indicator lexbuf
-  }
-| ident as id {
-    match id with
-      "default" | "hidden" ->
-        print_endline (id ^ message [] lexbuf)
-    | _ -> fail "Invalid line indicator." lexbuf
-  }
-| nl | eof { fail "Line indicator expected." lexbuf }
-
-and end_indicator = parse
-  blank* nl   { copy lexbuf; handle_nl lexbuf }
-| blank* eof  { copy lexbuf }
-| blank* "//" { copy lexbuf; print_endline (message [] lexbuf) }
-| blank+ '"'  { copy lexbuf;
-                handle_err in_norm_str lexbuf;
-                opt_line_com lexbuf }
-| _           { fail "Line comment or blank expected." lexbuf }
-
-and opt_line_com = parse
-  nl     { handle_nl lexbuf }
-| eof    { copy lexbuf }
-| blank+ { copy lexbuf; opt_line_com lexbuf }
-| "//"   { print_endline ("//" ^ message [] lexbuf) }
-
-(* New lines and verbatim sequence of characters *)
-
-and pp_newline = parse
-  nl     { handle_nl lexbuf }
-| blank+ { pp_newline lexbuf }
-| "//"   { in_line_com Skip lexbuf }
-| _      { fail "Only a single-line comment allowed." lexbuf }
-
-and message acc = parse
-  nl     { Lexing.new_line lexbuf;
-           mk_str (List.length acc) acc }
-| eof    { mk_str (List.length acc) acc }
-| _ as c { message (c::acc) lexbuf }
-
-(* Comments *)
-
-and in_line_com mode = parse
-  nl  { handle_nl lexbuf }
-| eof { flush stdout }
-| _   { if mode = Copy then copy lexbuf; in_line_com mode lexbuf }
-
-and in_block_com = parse
-  nl   { handle_nl lexbuf; in_block_com lexbuf }
-| "*/" { copy lexbuf }
-| eof  { raise (Local_err "Unterminated comment.") }
-| _    { copy lexbuf; in_block_com lexbuf }
-
-(* Include a file *)
-
-and cat = parse
-  eof { () }
-| _   { copy lexbuf; cat lexbuf }
-
-(* Included filename *)
-
-and scan_inclusion = parse
-  blank+ { scan_inclusion lexbuf                         }
-| '"'    { handle_err (in_inclusion [] 0) lexbuf    }
-
-and in_inclusion acc len = parse
-  '"'    { mk_str len acc                           }
-| nl     { fail "Newline invalid in string." lexbuf }
-| eof    { raise (Local_err "Unterminated string.") }
-| _ as c { in_inclusion (c::acc) (len+1) lexbuf     }
-
-(* Strings *)
-
-and in_norm_str = parse
-  "\\\"" { copy lexbuf; in_norm_str lexbuf }
-| '"'    { copy lexbuf }
-| nl     { fail "Newline invalid in string." lexbuf }
-| eof    { raise (Local_err "Unterminated string.") }
-| _      { copy lexbuf; in_norm_str lexbuf }
-
-and in_verb_str = parse
-  "\"\"" { copy lexbuf; in_verb_str lexbuf }
-| '"'    { copy lexbuf }
-| nl     { handle_nl lexbuf; in_verb_str lexbuf }
-| eof    { raise (Local_err "Unterminated string.") }
-| _      { copy lexbuf; in_verb_str lexbuf }
-
-{
-(* The function [lex] is a wrapper of [scan], which also checks that
-   the trace is empty at the end.  Note that we discard the
-   environment at the end. *)
-
-let lex buffer =
-  let _env, trace = scan Env.empty Copy (Prefix 0) [] buffer
-in assert (trace = [])
-
-(* Exported definitions *)
-
-type filename = string
-
-let trace (name: filename) : unit =
-  match open_in name with
-    cin ->
-    let open Lexing in
-    let buffer = from_channel cin in
-    let pos_fname = Filename.basename name in
-    let () = buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} in
-    let open Error
-      in (try lex buffer with
-            Lexer diag    -> print "Lexical" diag
-          | Parser diag   -> print "Syntactical" diag
-          | Eparser.Error -> print "" ("Parse", mk_seg buffer, 1));
-         close_in cin; flush stdout
-  | exception Sys_error msg -> prerr_endline msg
-
-}

vendors/Preproc/ProcMain.ml

@@ -1,5 +0,0 @@
-(* This is the entry point of the C# preprocessor. See [Makefile.cfg]. *)
-
-match Array.length Sys.argv with
-  2 -> Preproc.trace Sys.argv.(1)
-| _ -> prerr_endline ("Usage: " ^ Sys.argv.(0) ^ " [file]")

vendors/Preproc/README.md

@@ -1 +0,0 @@
-# A C# preprocessor in OCaml

vendors/Preproc/build.sh

@@ -1,23 +0,0 @@
-#!/bin/sh
-set -x
-ocamllex.opt Escan.mll
-ocamllex.opt Preproc.mll
-menhir -la 1 Eparser.mly
-ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c Etree.ml
-ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c Error.ml
-ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c Etree.ml
-ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c Error.ml
-ocamlfind ocamlc -strict-sequence -w +A-48-4 -c Eparser.mli
-camlcmd="ocamlfind ocamlc -I _i686 -strict-sequence -w +A-48-4   "
-menhir --infer --ocamlc="$camlcmd" Eparser.mly
-ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c Escan.ml
-ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c Eparser.ml
-ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c Preproc.ml
-ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c Escan.ml
-ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c Preproc.ml
-ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c EMain.ml
-ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c EMain.ml
-ocamlfind ocamlopt -o EMain.opt Etree.cmx Eparser.cmx Error.cmx Escan.cmx Preproc.cmx EMain.cmx
-ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c ProcMain.ml
-ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c ProcMain.ml
-ocamlfind ocamlopt -o ProcMain.opt Etree.cmx Eparser.cmx Error.cmx Escan.cmx Preproc.cmx ProcMain.cmx

vendors/Preproc/clean.sh

@@ -1,3 +0,0 @@
-#!/bin/sh
-
-\rm -f *.cm* *.o *.byte *.opt

vendors/Preproc/dune

@@ -1,20 +0,0 @@
-(ocamllex Escan Preproc)
-
-(menhir
-  (modules Eparser))
-
-(library
-  (name PreProc)
-;  (public_name ligo.preproc)
-  (wrapped false)
-  (modules Eparser Error Escan Etree Preproc))
-
-(test
-  (modules ProcMain)
-  (libraries PreProc)
-  (name ProcMain))
-
-(test
-  (modules EMain)
-  (libraries PreProc)
-  (name EMain))

vendors/Preprocessor/E_Lexer.mli

@@ -0,0 +1,22 @@
+(* Module for lexing boolean expressions of conditional directives *)
+
+(* Regions *)
+
+module Region = Simple_utils.Region
+
+val string_of_token : E_Parser.token -> string
+
+(* Errors *)
+
+type error = Invalid_character of char
+
+val error_to_string : error -> string
+
+val format :
+  ?offsets:bool -> error Region.reg -> file:bool -> string Region.reg
+
+(* Lexing boolean expressions (may raise [Error]) *)
+
+exception Error of error Region.reg
+
+val scan : Lexing.lexbuf -> E_Parser.token

vendors/Preprocessor/E_Lexer.mll

@@ -0,0 +1,105 @@
+(* Auxiliary scanner for boolean expressions of the C# preprocessor *)
+
+{
+(* START OF HEADER *)
+
+module Region = Simple_utils.Region
+module Pos = Simple_utils.Pos
+
+let sprintf = Printf.sprintf
+
+open E_Parser
+
+(* Concrete syntax of tokens. See module [E_Parser]. *)
+
+let string_of_token = function
+      True -> "true"
+|    False -> "false"
+| Ident id -> id
+|       OR -> "||"
+|      AND -> "&&"
+|       EQ -> "=="
+|      NEQ -> "!="
+|      NOT -> "!"
+|     LPAR -> "("
+|     RPAR -> ")"
+|      EOL -> "EOL"
+
+(* Errors *)
+
+type error = Invalid_character of char
+
+let error_to_string = function
+    Invalid_character c ->
+      sprintf "Invalid character '%c' (%d)." c (Char.code c)
+
+let format ?(offsets=true) Region.{region; value} ~file =
+  let msg   = error_to_string value
+  and reg   = region#to_string ~file ~offsets `Byte in
+  let value = sprintf "Preprocessing error %s:\n%s\n" reg msg
+  in Region.{value; region}
+
+exception Error of error Region.reg
+
+let mk_reg buffer =
+  let start  = Lexing.lexeme_start_p buffer |> Pos.from_byte
+  and stop   = Lexing.lexeme_end_p buffer |> Pos.from_byte
+  in Region.make ~start ~stop
+
+let stop value region = raise (Error Region.{region; value})
+let fail error buffer = stop error (mk_reg buffer)
+
+(* END OF HEADER *)
+}
+
+(* Regular expressions for literals *)
+
+(* White space *)
+
+let newline = '\n' | '\r' | "\r\n"
+let blank = ' ' | '\t'
+
+(* Unicode escape sequences *)
+
+let digit = ['0'-'9']
+let hexdigit = digit | ['A'-'F' 'a'-'f']
+let four_hex = hexdigit hexdigit hexdigit hexdigit
+let uni_esc = "\\u" four_hex | "\\U"  four_hex four_hex
+
+(* Identifiers *)
+
+let lowercase = ['a'-'z']
+let uppercase = ['A'-'Z']
+let letter = lowercase | uppercase | uni_esc
+let start = '_' | letter
+let alphanum = letter | digit | '_'
+let ident = start alphanum*
+
+(* Rules *)
+
+rule scan = parse
+  blank+      { scan lexbuf }
+| newline     { Lexing.new_line lexbuf; EOL }
+| eof         { EOL       }
+| "true"      { True      }
+| "false"     { False     }
+| ident as id { Ident id  }
+| '('         { LPAR      }
+| ')'         { RPAR      }
+| "||"        { OR        }
+| "&&"        { AND       }
+| "=="        { EQ        }
+| "!="        { NEQ       }
+| "!"         { NOT       }
+| "//"        { inline_com lexbuf }
+| _ as c      { fail (Invalid_character c) lexbuf }
+
+and inline_com = parse
+  newline { Lexing.new_line lexbuf; EOL }
+| eof     { EOL }
+| _       { inline_com lexbuf }
+
+{
+  (* START OF TRAILER *)
+  (* END OF TRAILER *)
+}

vendors/Preprocessor/E_LexerMain.ml

@@ -0,0 +1,33 @@
+(* Standalone lexer for booleans expression of preprocessing
+   directives for PascaLIGO *)
+
+module Region = Simple_utils.Region
+
+let highlight msg = Printf.eprintf "\027[31m%s\027[0m%!" msg
+
+let options = EvalOpt.(read ~lang:`PascaLIGO ~ext:".ligo")
+
+let lex in_chan =
+  let buffer = Lexing.from_channel in_chan in
+  let open Lexing in
+  let () =
+    match options#input with
+      Some "-" | None -> ()
+    | Some pos_fname ->
+        buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} in
+  let rec iter () =
+    match E_Lexer.scan buffer with
+      token -> Printf.printf "%s\n" (E_Lexer.string_of_token token);
+              if token <> E_Parser.EOL then iter ()
+    | exception E_Lexer.Error err ->
+        let formatted =
+          E_Lexer.format ~offsets:options#offsets ~file:true err
+        in highlight formatted.Region.value
+  in iter (); close_in in_chan
+
+let () =
+  match options#input with
+    Some "-" | None -> lex stdin
+  | Some file_path ->
+     try open_in file_path |> lex with
+       Sys_error msg -> highlight msg

vendors/Preprocessor/E_Parser.mly

@@ -0,0 +1,50 @@
+%{
+(* Grammar for boolean expressions in preprocessing directives of C# *)
+%}
+
+%token <string> Ident "<ident>"
+%token True "true"
+%token False "false"
+%token OR "||"
+%token AND "&&"
+%token EQ "=="
+%token NEQ "!="
+%token NOT "!"
+%token LPAR "("
+%token RPAR ")"
+%token EOL
+
+(* Entries *)
+
+%start expr
+%type <E_AST.t> expr
+
+%%
+
+(* Grammar *)
+
+expr:
+  or_expr EOL { $1 }
+
+or_expr:
+  or_expr "||" and_expr         { E_AST.Or ($1,$3)  }
+| and_expr                      { $1                }
+
+and_expr:
+  and_expr "&&" unary_expr      { E_AST.And ($1,$3) }
+| equality_expr                 { $1                }
+
+equality_expr:
+  equality_expr "==" unary_expr { E_AST.Eq ($1,$3)  }
+| equality_expr "!=" unary_expr { E_AST.Neq ($1,$3) }
+| unary_expr                    { $1                }
+
+unary_expr:
+  primary_expr                  { $1                }
+| "!" unary_expr                { E_AST.Not $2      }
+
+primary_expr:
+  "true"                        { E_AST.True        }
+| "false"                       { E_AST.False       }
+| "<ident>"                     { E_AST.Ident $1    }
+| "(" or_expr ")"               { $2                }

vendors/Preprocessor/E_ParserMain.ml

@@ -0,0 +1,43 @@
+(* Standalone parser for booleans expression of preprocessing
+   directives for PascaLIGO *)
+
+module Region = Simple_utils.Region
+
+let highlight msg = Printf.eprintf "\027[31m%s\027[0m%!" msg
+
+let options = EvalOpt.(read ~lang:`PascaLIGO ~ext:".ligo")
+
+let parse in_chan =
+  let buffer = Lexing.from_channel in_chan in
+  let open Lexing in
+  let () =
+    match options#input with
+      Some "-" | None -> ()
+    | Some pos_fname ->
+        buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} in
+    let () =
+      try
+        let tree  = E_Parser.expr E_Lexer.scan buffer in
+        let value = Preproc.(eval Env.empty tree)
+        in Printf.printf "%s\n" (string_of_bool value)
+      with
+        E_Lexer.Error error ->
+          let formatted =
+            E_Lexer.format ~offsets:options#offsets ~file:true error
+          in highlight formatted.Region.value
+      | E_Parser.Error ->
+          let region = Preproc.mk_reg buffer
+          and value  = Preproc.Parse_error in
+          let error  = Region.{value; region} in
+          let formatted =
+            Preproc.format ~offsets:options#offsets
+                           ~file:true error
+          in highlight formatted.Region.value
+    in close_in in_chan
+
+let () =
+  match options#input with
+    Some "-" | None -> parse stdin
+  | Some file_path ->
+     try open_in file_path |> parse with
+       Sys_error msg -> highlight msg

vendors/Preprocessor/EvalOpt.ml

@@ -0,0 +1,124 @@
+(* Parsing command-line options *)
+
+(* The type [options] gathers the command-line options. *)
+
+type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO]
+
+let lang_to_string = function
+  `PascaLIGO  -> "PascaLIGO"
+| `CameLIGO   -> "CameLIGO"
+| `ReasonLIGO -> "ReasonLIGO"
+
+module SSet = Set.Make (String)
+
+type options = <
+  input   : string option;
+  libs    : string list;
+  verbose : SSet.t;
+  offsets : bool;
+  lang    : language;
+  ext     : string   (* ".ligo", ".mligo", ".religo" *)
+>
+
+let make ~input ~libs ~lang ~offsets ~verbose ~ext : options =
+  object
+    method input   = input
+    method libs    = libs
+    method lang    = lang
+    method offsets = offsets
+    method verbose = verbose
+    method ext     = ext
+  end
+
+(* Auxiliary functions and modules *)
+
+let  printf = Printf.printf
+let sprintf = Printf.sprintf
+let   print = print_endline
+
+(* Printing a string in red to standard error *)
+
+let highlight msg = Printf.eprintf "\027[31m%s\027[0m%!" msg
+
+(* Failure *)
+
+let abort msg =
+  highlight (sprintf "Command-line error: %s\n" msg); exit 1
+
+(* Help *)
+
+let help lang ext () =
+  let file = Filename.basename Sys.argv.(0) in
+  printf "Usage: %s [<option> ...] [<input>%s | \"-\"]\n" file ext;
+  printf "where <input>%s is the %s source file (default: stdin),\n" ext lang;
+  print "and each <option> (if any) is one of the following:";
+  print "  -I <paths>             Inclusion paths (colon-separated)";
+  print "      --columns          Columns for source locations";
+  print "      --verbose=<stages> preproc";
+  print "  -h, --help             This help";
+  exit 0
+
+(* Specifying the command-line options a la GNU *)
+
+let input    = ref None
+and libs     = ref []
+and columns  = ref false
+and verbose  = ref SSet.empty
+and verb_str = ref ""
+
+let split_at_colon = Str.(split (regexp ":"))
+
+let add_path p = libs := !libs @ split_at_colon p
+
+let add_verbose d =
+  verbose := List.fold_left (fun x y -> SSet.add y x)
+                            !verbose
+                            (split_at_colon d)
+let specs lang ext =
+  let lang_str = lang_to_string lang in
+  let open!Getopt in [
+    'I',     nolong,    None, Some add_path;
+    'h',     "help",    Some (help lang_str ext), None;
+    noshort, "columns", set columns true, None;
+    noshort, "verbose", None, Some add_verbose
+  ]
+
+(* Handler of anonymous arguments *)
+
+let anonymous arg =
+  match !input with
+      None -> input := Some arg
+  | Some _ -> abort (sprintf "Multiple inputs")
+
+(* Checking options and exporting them as non-mutable values *)
+
+let check lang ext =
+  let libs = !libs
+
+  and offsets = not !columns
+
+  and verbose = !verbose
+
+  and input =
+    match !input with
+      None | Some "-" -> None
+    | Some file_path ->
+        if   Filename.check_suffix file_path ext
+        then if   Sys.file_exists file_path
+             then Some file_path
+             else abort "Source file not found."
+        else abort ("Source file lacks the extension " ^ ext ^ ".")
+
+ in make ~input ~libs ~lang ~offsets ~verbose ~ext
+
+(* Parsing the command-line options *)
+
+let read ~lang:(lang : language) ~ext:(ext : string) =
+  try
+    Getopt.parse_cmdline (specs lang ext) anonymous;
+    (verb_str :=
+       let apply e a =
+         if a = "" then e else sprintf "%s, %s" e a
+       in SSet.fold apply !verbose "");
+    check lang ext
+  with Getopt.Error msg -> abort msg

vendors/Preprocessor/EvalOpt.mli

@@ -0,0 +1,33 @@
+(* Parsing the command-line options of the LIGO preprocessor *)
+
+(* The type [options] gathers the command-line options. *)
+
+type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO]
+
+val lang_to_string : language -> string
+
+module SSet : Set.S with type elt = string and type t = Set.Make(String).t
+
+type options = <
+  input   : string option;
+  libs    : string list;
+  verbose : SSet.t;
+  offsets : bool;
+  lang    : language;
+  ext     : string   (* ".ligo", ".mligo", ".religo" *)
+>
+
+val make :
+  input:string option ->
+  libs:string list ->
+  lang:language ->
+  offsets:bool ->
+  verbose:SSet.t ->
+  ext:string ->
+  options
+
+(* Parsing the command-line options on stdin. The first parameter is
+   the name of the concrete syntax. This is needed to correctly handle
+   comments. *)
+
+val read : lang:language -> ext:string -> options

vendors/Preprocessor/LICENSE

@@ -1,6 +1,7 @@
 MIT License
 
-Copyright (c) 2018 Christian Rinderknecht
+Copyright (c) 2018, 2019, 2020 Christian Rinderknecht,
+                          2020 LigoLANG
 
 Permission is hereby granted, free of charge, to any person obtaining a copy
 of this software and associated documentation files (the "Software"), to deal

vendors/Preprocessor/Makefile.cfg

@@ -1,4 +1,5 @@
 SHELL := dash
 BFLAGS := -strict-sequence -w +A-48-4
-#OCAMLC := ocamlcp
-#OCAMLOPT := ocamloptp
+
+clean::
+> \rm -f Version.ml

vendors/Preprocessor/Preproc.mli

@@ -0,0 +1,51 @@
+(* The main module of the preprocessor (see [lex]) *)
+
+(* Regions *)
+
+module Region = Simple_utils.Region
+
+val mk_reg : Lexing.lexbuf -> Region.t
+
+(* Errors *)
+
+type error =
+  Directive_inside_line
+| Missing_endif
+| Invalid_line_indicator of string
+| No_line_indicator
+| End_line_indicator
+| Newline_in_string (* For #include argument only *)
+| Open_string       (* For #include argument only *)
+| Dangling_endif
+| Open_region_in_conditional
+| Dangling_endregion
+| Conditional_in_region
+| If_follows_elif
+| Else_follows_else
+| Dangling_else
+| Elif_follows_else
+| Dangling_elif
+| Reserved_symbol of string
+| Multiply_defined_symbol of string
+| Error_directive of string
+| Parse_error
+| No_line_comment_or_blank
+| Invalid_symbol
+| File_not_found of string
+| Invalid_character of char
+
+val format :
+  ?offsets:bool -> error Region.reg -> file:bool -> string Region.reg
+
+(* Preprocessing a lexing buffer *)
+
+val lex :
+  EvalOpt.options ->
+  Lexing.lexbuf ->
+  (Buffer.t, Buffer.t * error Region.reg) Stdlib.result
+
+(* Evaluation of boolean expressions *)
+
+module Env : Set.S with type elt = string
+
+val eval : Env.t -> E_AST.t -> bool

vendors/Preprocessor/Preproc.mll

@@ -0,0 +1,768 @@
+(* Simple preprocessor based on C#, to be processed by [ocamllex]. *)
+
+{
+(* START OF HEADER *)
+
+module Region = Simple_utils.Region
+module Pos = Simple_utils.Pos
+
+let sprintf = Printf.sprintf
+
+(* Rolling back one lexeme _within the current semantic action_ *)
+
+let rollback buffer =
+  let open Lexing in
+  let len = String.length (lexeme buffer) in
+  let pos_cnum = buffer.lex_curr_p.pos_cnum - len in
+  buffer.lex_curr_pos <- buffer.lex_curr_pos - len;
+  buffer.lex_curr_p <- {buffer.lex_curr_p with pos_cnum}
+
+(* STRING PROCESSING *)
+
+(* The value of [mk_str len p] ("make string") is a string of length
+   [len] containing the [len] characters in the list [p], in reverse
+   order. For instance, [mk_str 3 ['c';'b';'a'] = "abc"]. *)
+
+ let mk_str (len: int) (p: char list) : string =
+  let () = assert (len = List.length p) in
+  let bytes = Bytes.make len ' ' in
+  let rec fill i = function
+         [] -> bytes
+  | char::l -> Bytes.set bytes i char; fill (i-1) l
+  in fill (len-1) p |> Bytes.to_string
+
+(* The type [mode] defines the two scanning modes of the preprocessor:
+   either we copy the current characters or we skip them. *)
+
+type mode = Copy | Skip
+
+(* Trace of directives
+
+   We keep track of directives #if, #elif, #else, #region and #endregion.
+*)
+
+type cond  = If of mode | Elif of mode | Else | Region
+type trace = cond list
+
+(* Line offsets
+
+   The value [Inline] of type [offset] means that the current location
+   cannot be reached from the start of the line with only white
+   space. The same holds for the special value [Prefix 0]. Values of
+   the form [Prefix n] mean that the current location can be reached
+   from the start of the line with [n] white spaces (padding). These
+   distinctions are needed because preprocessor directives cannot
+   occur inside lines.
+*)
+
+type offset = Prefix of int | Inline
+
+(* Environments *)
+
+module Env = Set.Make (String)
+
+let rec eval env =
+  let open E_AST
+in function
+   Or (e1,e2) -> eval env e1 || eval env e2
+| And (e1,e2) -> eval env e1 && eval env e2
+|  Eq (e1,e2) -> eval env e1 = eval env e2
+| Neq (e1,e2) -> eval env e1 != eval env e2
+|       Not e -> not (eval env e)
+|        True -> true
+|       False -> false
+|    Ident id -> Env.mem id env
+
+(* The type [state] groups the information that needs to be threaded
+   along the scanning functions:
+     * the field [env] records the symbols defined;
+     * the field [mode] informs whether the preprocessor is in copying or
+       skipping mode;
+     * the field [offset] tells whether the current location can be
+       reached from the start of the line with only white space;
+     * the field [trace] is a stack of previous, still active conditional
+       directives;
+     * the field [out] keeps the output buffer;
+     * the field [incl] is a list of opened input channels (#include);
+     * the field [opt] holds the CLI options;
+     * the field [dir] is the file system's path to the the current input
+       file.
+*)
+
+type state = {
+  env     : Env.t;
+  mode    : mode;
+  offset  : offset;
+  trace   : trace;
+  out     : Buffer.t;
+  incl    : in_channel list;
+  opt     : EvalOpt.options;
+  dir     : string list
+}
+
+(* Directories *)
+
+let push_dir dir state =
+  if dir = "." then state else {state with dir = dir :: state.dir}
+
+let mk_path state =
+  String.concat Filename.dir_sep (List.rev state.dir)
+
+(* ERRORS *)
+
+type error =
+  Directive_inside_line
+| Missing_endif
+| Invalid_line_indicator of string
+| No_line_indicator
+| End_line_indicator
+| Newline_in_string
+| Open_string
+| Dangling_endif
+| Open_region_in_conditional
+| Dangling_endregion
+| Conditional_in_region
+| If_follows_elif
+| Else_follows_else
+| Dangling_else
+| Elif_follows_else
+| Dangling_elif
+| Reserved_symbol of string
+| Multiply_defined_symbol of string
+| Error_directive of string
+| Parse_error
+| No_line_comment_or_blank
+| Invalid_symbol
+| File_not_found of string
+| Invalid_character of char
+
+let error_to_string = function
+  Directive_inside_line ->
+    sprintf "Directive inside a line."
+| Missing_endif ->
+    sprintf "Missing #endif directive."
+| Invalid_line_indicator id ->
+    sprintf "Invalid line indicator \"%s\".\n\
+             Hint: Try \"default\" or \"hidden\"." id
+| No_line_indicator ->
+    sprintf "Missing line indicator."
+| End_line_indicator ->
+    sprintf "Invalid ending of numerical line indicator.\n\
+             Hint: Try a string, end of line, or a line comment."
+| Newline_in_string ->
+    sprintf "Invalid newline character in string."
+| Open_string ->
+    sprintf "Unterminated string.\n\
+             Hint: Close with double quotes."
+| Dangling_endif ->
+    sprintf "Dangling #endif directive.\n\
+             Hint: Remove it or add a #if before."
+| Open_region_in_conditional ->
+    sprintf "Unterminated of #region in conditional.\n\
+             Hint: Close with #endregion before #endif."
+| Dangling_endregion ->
+    sprintf "Dangling #endregion directive.\n\
+             Hint: Remove it or use #region before."
+| Conditional_in_region ->
+    sprintf "Conditional in region.\n\
+             Hint: Remove the conditional or the region."
+| If_follows_elif ->
+    sprintf "Directive #if found in a clause #elif."
+| Else_follows_else ->
+    sprintf "Directive #else found in a clause #else."
+| Dangling_else ->
+    sprintf "Directive #else without #if."
+| Elif_follows_else ->
+    sprintf "Directive #elif found in a clause #else."
+| Dangling_elif ->
+    sprintf "Dangling #elif directive.\n\
+             Hint: Remove it or add a #if before."
+| Reserved_symbol sym ->
+    sprintf "Reserved symbol \"%s\".\n\
+             Hint: Use another symbol." sym
+| Multiply_defined_symbol sym ->
+    sprintf "Multiply-defined symbol \"%s\".\n\
+             Hint: Change the name or remove one definition." sym
+| Error_directive msg ->
+    msg
+| Parse_error ->
+    "Parse error in expression."
+| No_line_comment_or_blank ->
+    "Line comment or whitespace expected."
+| Invalid_symbol ->
+    "Expected a symbol (identifier)."
+| File_not_found name ->
+    sprintf "File \"%s\" to include not found." name
+| Invalid_character c ->
+    E_Lexer.error_to_string (E_Lexer.Invalid_character c)
+
+let format ?(offsets=true) Region.{region; value} ~file =
+  let msg   = error_to_string value
+  and reg   = region#to_string ~file ~offsets `Byte in
+  let value = sprintf "Preprocessing error %s:\n%s" reg msg
+  in Region.{value; region}
+
+exception Error of (Buffer.t * error Region.reg)
+
+let mk_reg buffer =
+  let start  = Lexing.lexeme_start_p buffer |> Pos.from_byte
+  and stop   = Lexing.lexeme_end_p buffer |> Pos.from_byte
+  in Region.make ~start ~stop
+
+(* IMPORTANT : Make sure the function [stop] remains the only one
+   raising [Error]. *)
+
+let stop value state region =
+  List.iter close_in state.incl;
+  raise (Error (state.out, Region.{region; value}))
+
+let fail error state buffer = stop error state (mk_reg buffer)
+
+(* The function [reduce_cond] is called when a #endif directive is
+   found, and the trace (see type [trace] above) needs updating. *)
+
+let reduce_cond state region =
+  let rec reduce = function
+                [] -> stop Dangling_endif state region
+  | If mode::trace -> {state with mode; trace; offset = Prefix 0}
+  |      Region::_ -> stop Open_region_in_conditional state region
+  |       _::trace -> reduce trace
+  in reduce state.trace
+
+(* The function [reduce_region] is called when a #endregion directive is
+   read, and the trace needs updating. *)
+
+let reduce_region state region =
+  match state.trace with
+               [] -> stop Dangling_endregion state region
+  | Region::trace -> {state with trace; offset = Prefix 0}
+  |             _ -> stop Conditional_in_region state region
+
+(* The function [extend] is called when encountering conditional
+   directives #if, #else and #elif. As its name suggests, it extends
+   the current trace with the current conditional directive, whilst
+   performing some validity checks. *)
+
+let extend cond state region =
+  match cond, state.trace with
+    If _, Elif _::_ -> stop If_follows_elif state region
+  | Else,   Else::_ -> stop Else_follows_else state region
+  | Else,        [] -> stop Dangling_else state region
+  | Elif _, Else::_ -> stop Elif_follows_else state region
+  | Elif _,      [] -> stop Dangling_elif state region
+  |     hd,     tl  -> hd::tl
+
+(* The function [last_mode] seeks the last mode as recorded in the
+   trace (see type [trace] above). *)
+
+let rec last_mode = function
+                        [] -> assert false
+| (If mode | Elif mode)::_ -> mode
+|                 _::trace -> last_mode trace
+
+(* Finding a file to #include *)
+
+let rec find base = function
+         [] -> None
+| dir::dirs ->
+    let path =
+      if dir = "." || dir = "" then base
+      else dir ^ Filename.dir_sep ^ base in
+    try Some (path, open_in path) with
+      Sys_error _ -> find base dirs
+
+let find dir file libs =
+  let path =
+    if dir = "." || dir = "" then file
+    else dir ^ Filename.dir_sep ^ file in
+  try Some (path, open_in path) with
+    Sys_error _ ->
+      let base = Filename.basename file in
+      if base = file then find file libs else None
+
+(* PRINTING *)
+
+(* Copying the current lexeme to [stdout] *)
+
+let copy state buffer = Buffer.add_string state.out (Lexing.lexeme buffer)
+
+(* End of lines *)
+
+let proc_nl state buffer = Lexing.new_line buffer; copy state buffer
+
+(* Copying a string *)
+
+let print state string = Buffer.add_string state.out string
+
+(* Expanding the offset into whitespace *)
+
+let expand_offset state =
+  match state.offset with
+    Prefix 0 | Inline -> ()
+  | Prefix n -> print state (String.make n ' ')
+
+(* Evaluating a preprocessor expression
+
+   The evaluation of conditional directives may involve symbols whose
+   value may be defined using #define directives, or undefined by
+   means of #undef. Therefore, we need to evaluate conditional
+   expressions in an environment made of a set of defined symbols.
+
+   Note that we rely on an external lexer and parser for the
+   conditional expressions. See modules [E_Lexer] and [E_Parser].
+*)
+
+let expr state buffer : mode =
+  let ast =
+    try E_Parser.expr E_Lexer.scan buffer with
+      E_Lexer.Error Region.{value; region} ->
+        (match value with
+           E_Lexer.Invalid_character c ->
+             stop (Invalid_character c) state region)
+    | E_Parser.Error ->
+        fail Parse_error state buffer in
+  let () = print state "\n" in
+  if eval state.env ast then Copy else Skip
+
+(* DIRECTIVES *)
+
+let directives = [
+  "define"; "elif"; "else"; "endif"; "endregion"; "error";
+  "if"; "include"; (*"line";*) "region"; "undef" (* "; warning" *)
+]
+
+(* END OF HEADER *)
+}
+
+(* REGULAR EXPRESSIONS *)
+
+let nl        = '\n' | '\r' | "\r\n"
+let blank     = ' ' | '\t'
+let digit     = ['0'-'9']
+let natural   = digit | digit (digit | '_')* digit
+let small     = ['a'-'z']
+let capital   = ['A'-'Z']
+let letter    = small | capital
+let ident     = letter (letter | '_' | digit)*
+let directive = '#' (blank* as space) (small+ as id)
+
+(* Rules *)
+
+(* The rule [scan] scans the input buffer for directives, strings,
+   comments, blanks, new lines and end of file characters. As a
+   result, either the matched input is copied to [stdout] or not,
+   depending on the compilation directives. If not copied, new line
+   characters are output.
+
+   Scanning is triggered by the function call [scan env mode offset
+   trace lexbuf], where [env] is the set of defined symbols
+   (introduced by `#define'), [mode] specifies whether we are copying
+   or skipping the input, [offset] informs about the location in the
+   line (either there is a prefix of blanks, or at least a non-blank
+   character has been read), and [trace] is the stack of conditional
+   directives read so far.
+
+   The first call is [scan {env=Env.empty; mode=Copy; offset = Prefix
+   0; trace=[]; incl=[]; opt}], meaning that we start with an empty
+   environment, that copying the input is enabled by default, and that
+   we are at the start of a line and no previous conditional
+   directives have been read yet. The field [opt] is the CLI options.
+
+   When an "#if" is matched, the trace is extended by the call [extend
+   lexbuf (If mode) trace], during the evaluation of which the
+   syntactic validity of having encountered an "#if" is checked (for
+   example, it would be invalid had an "#elif" been last read). Note
+   that the current mode is stored in the trace with the current
+   directive -- that mode may be later restored (see below for some
+   examples). Moreover, the directive would be deemed invalid if its
+   current position in the line (that is, its offset) were not
+   preceeded by blanks or nothing, otherwise the rule [expr] is called
+   to scan the boolean expression associated with the "#if": if it
+   evaluates to [true], the result is [Copy], meaning that we may copy
+   what follows, otherwise skip it -- the actual decision depending on
+   the current mode. That new mode is used if we were in copy mode,
+   and the offset is reset to the start of a new line (as we read a
+   new line in [expr]); otherwise we were in skipping mode and the
+   value of the conditional expression must be ignored (but not its
+   syntax), and we continue skipping the input.
+
+   When an "#else" is matched, the trace is extended with [Else],
+   then, if the directive is not at a wrong offset, the rest of the
+   line is scanned with [skip_line]. If we were in copy mode, the new
+   mode toggles to skipping mode; otherwise, the trace is searched for
+   the last encountered "#if" of "#elif" and the associated mode is
+   restored.
+
+   The case "#elif" is the result of the fusion (in the technical
+   sense) of the code for dealing with an "#else" followed by an
+   "#if".
+
+   When an "#endif" is matched, the trace is reduced, that is, all
+   conditional directives are popped until an [If mode'] is found and
+   [mode'] is restored as the current mode.
+
+   Consider the following four cases, where the modes (Copy/Skip) are
+   located between the lines:
+
+                    Copy ----+                          Copy ----+
+   #if true                  |       #if true                    |
+                    Copy     |                          Copy     |
+   #else                     |       #else                       |
+                +-- Skip --+ |                      +-- Skip --+ |
+     #if true   |          | |         #if false    |          | |
+                |   Skip   | |                      |   Skip   | |
+     #else      |          | |         #else        |          | |
+                +-> Skip   | |                      +-> Skip   | |
+     #endif                | |         #endif                  | |
+                    Skip <-+ |                          Skip <-+ |
+   #endif                    |       #endif                      |
+                    Copy <---+                          Copy <---+
+
+
+                +-- Copy ----+                          Copy --+-+
+   #if false    |            |       #if false                 | |
+                |   Skip     |                          Skip   | |
+   #else        |            |       #else                     | |
+                +-> Copy --+ |                    +-+-- Copy <-+ |
+     #if true              | |         #if false  | |            |
+                    Copy   | |                    | |   Skip     |
+     #else                 | |         #else      | |            |
+                    Skip   | |                    | +-> Copy     |
+     #endif                | |         #endif     |              |
+                    Copy <-+ |                    +---> Copy     |
+   #endif                    |       #endif                      |
+                    Copy <---+                          Copy <---+
+
+   The following four cases feature #elif. Note that we put between
+   brackets the mode saved for the #elif, which is sometimes restored
+   later.
+
+                    Copy --+                            Copy --+
+   #if true                |         #if true                  |
+                    Copy   |                            Copy   |
+   #elif true   +--[Skip]  |         #elif false    +--[Skip]  |
+                |   Skip   |                        |   Skip   |
+   #else        |          |         #else          |          |
+                +-> Skip   |                        +-> Skip   |
+   #endif                  |         #endif                    |
+                    Copy <-+                            Copy <-+
+
+
+                +-- Copy --+-+                      +-- Copy ----+
+   #if false    |          | |       #if false      |            |
+                |   Skip   | |                      |   Skip     |
+   #elif true   +->[Copy]  | |       #elif false    +->[Copy]--+ |
+                    Copy <-+ |                          Skip   | |
+   #else                     |       #else                     | |
+                    Skip     |                          Copy <-+ |
+   #endif                    |       #endif                      |
+                    Copy <---+                          Copy <---+
+
+   Note how "#elif" indeed behaves like an "#else" followed by an
+   "#if", and the mode stored with the data constructor [Elif]
+   corresponds to the mode before the virtual "#if".
+
+   Important note: Comments and strings are recognised as such only in
+   copy mode, which is a different behaviour from the preprocessor of
+   GNU GCC, which always does.
+*)
+
+rule scan state = parse
+  nl    { expand_offset state; proc_nl state lexbuf;
+          scan {state with offset = Prefix 0} lexbuf }
+| blank { match state.offset with
+            Prefix n ->
+              scan {state with offset = Prefix (n+1)} lexbuf
+          | Inline ->
+              if state.mode = Copy then copy state lexbuf;
+              scan state lexbuf }
+| directive {
+    if   not (List.mem id directives)
+    then begin
+           if state.mode = Copy then copy state lexbuf;
+           scan state lexbuf
+         end
+    else
+    if   state.offset = Inline
+    then fail Directive_inside_line state lexbuf
+    else
+    let region = mk_reg lexbuf in
+    match id with
+      "include" ->
+        let line = Lexing.(lexbuf.lex_curr_p.pos_lnum)
+        and file = Lexing.(lexbuf.lex_curr_p.pos_fname) in
+        let base = Filename.basename file
+        and reg, incl_file = scan_inclusion state lexbuf in
+        let incl_dir = Filename.dirname incl_file in
+        let path = mk_path state in
+        let incl_path, incl_chan =
+          match find path incl_file state.opt#libs with
+            Some p -> p
+          | None -> stop (File_not_found incl_file) state reg in
+        let () = print state (sprintf "\n# 1 \"%s\" 1\n" incl_path) in
+        let incl_buf = Lexing.from_channel incl_chan in
+        let () =
+          let open Lexing in
+          incl_buf.lex_curr_p <-
+            {incl_buf.lex_curr_p with pos_fname = incl_file} in
+        let state  = {state with incl = incl_chan::state.incl} in
+        let state' =
+          {state with env=Env.empty; mode=Copy; trace=[]} in
+        let state' = scan (push_dir incl_dir state') incl_buf in
+        let state  = {state with incl = state'.incl} in
+        let path =
+          if path = "" then base
+          else path ^ Filename.dir_sep ^ base in
+        print state (sprintf "\n# %i \"%s\" 2" (line+1) path);
+        scan state lexbuf
+    | "if" ->
+        let mode  = expr state lexbuf in
+        let mode  = if state.mode = Copy then mode else Skip in
+        let trace = extend (If state.mode) state region in
+        let state = {state with mode; offset = Prefix 0; trace}
+        in scan state lexbuf
+    | "else" ->
+        let () = skip_line state lexbuf in
+        let mode = match state.mode with
+                     Copy -> Skip
+                   | Skip -> last_mode state.trace in
+        let trace = extend Else state region
+        in scan {state with mode; offset = Prefix 0; trace} lexbuf
+    | "elif" ->
+        let mode = expr state lexbuf in
+        let trace, mode =
+          match state.mode with
+            Copy -> extend (Elif Skip) state region, Skip
+          | Skip -> let old_mode = last_mode state.trace
+                    in extend (Elif old_mode) state region,
+                       if old_mode = Copy then mode else Skip
+        in scan {state with mode; offset = Prefix 0; trace} lexbuf
+    | "endif" ->
+        skip_line state lexbuf;
+        scan (reduce_cond state region) lexbuf
+    | "define" ->
+        let id, region = variable state lexbuf in
+        if id="true" || id="false"
+        then stop (Reserved_symbol id) state region;
+        if Env.mem id state.env
+        then stop (Multiply_defined_symbol id) state region;
+        let state = {state with env = Env.add id state.env;
+                                offset = Prefix 0}
+        in scan state lexbuf
+    | "undef" ->
+        let id, _ = variable state lexbuf in
+        let state = {state with env = Env.remove id state.env;
+                                offset = Prefix 0}
+        in scan state lexbuf
+    | "error" ->
+        stop (Error_directive (message [] lexbuf)) state region
+    | "region" ->
+        let msg = message [] lexbuf
+        in expand_offset state;
+           print state ("#" ^ space ^ "region" ^ msg ^ "\n");
+           let state =
+             {state with offset = Prefix 0; trace=Region::state.trace}
+           in scan state lexbuf
+    | "endregion" ->
+        let msg = message [] lexbuf
+        in expand_offset state;
+           print state ("#" ^ space ^ "endregion" ^ msg ^ "\n");
+           scan (reduce_region state region) lexbuf
+(*
+    | "line" ->
+        expand_offset state;
+        print state ("#" ^ space ^ "line");
+        line_ind state lexbuf;
+        scan {state with offset = Prefix 0} lexbuf
+
+    | "warning" ->
+        let start_p, end_p = region in
+        let msg = message [] lexbuf in
+        let open Lexing
+        in prerr_endline
+             ("Warning at line " ^ string_of_int start_p.pos_lnum
+             ^ ", char "
+             ^ string_of_int (start_p.pos_cnum - start_p.pos_bol)
+             ^ "--" ^ string_of_int (end_p.pos_cnum - end_p.pos_bol)
+             ^ ":\n" ^ msg);
+           scan env mode (Prefix 0) trace lexbuf
+ *)
+    | _ -> assert false
+  }
+| eof   { match state.trace with
+            [] -> expand_offset state; state
+          |  _ -> fail Missing_endif state lexbuf }
+| '"'   { if state.mode = Copy then
+            begin
+              expand_offset state;
+              copy state lexbuf;
+              in_string (mk_reg lexbuf) state lexbuf
+            end;
+          scan {state with offset=Inline} lexbuf }
+| "//"  { if state.mode = Copy then
+            begin
+              expand_offset state;
+              copy state lexbuf;
+              in_line_com state lexbuf
+            end;
+          scan {state with offset=Inline} lexbuf }
+| "/*"  { if state.mode = Copy then
+            begin
+              expand_offset state;
+              copy state lexbuf;
+              if state.opt#lang = `ReasonLIGO then
+                reasonLIGO_com (mk_reg lexbuf) state lexbuf
+            end;
+          scan {state with offset=Inline} lexbuf }
+| "(*"  { if state.mode = Copy then
+            begin
+              expand_offset state;
+              copy state lexbuf;
+              if state.opt#lang = `CameLIGO
+               || state.opt#lang = `PascaLIGO then
+                cameLIGO_com (mk_reg lexbuf) state lexbuf
+            end;
+          scan {state with offset=Inline} lexbuf }
+| _     { if state.mode = Copy then
+            begin
+              expand_offset state;
+              copy state lexbuf
+            end;
+          scan {state with offset=Inline} lexbuf }
+
+(* Support for #define and #undef *)
+
+and variable state = parse
+  blank+ { let id = symbol state lexbuf
+           in skip_line state lexbuf; id }
+
+and symbol state = parse
+  ident as id { id, mk_reg lexbuf                }
+| _           { fail Invalid_symbol state lexbuf }
+
+(*
+(* Line indicator (#line) *)
+
+and line_ind state = parse
+  blank* { copy state lexbuf; line_indicator state lexbuf }
+
+and line_indicator state = parse
+  natural  { copy state lexbuf; end_indicator state lexbuf }
+| ident as id {
+    match id with
+      "default" | "hidden" ->
+        print state (id ^ message [] lexbuf)
+    | _ -> fail (Invalid_line_indicator id) state lexbuf   }
+| _ { fail No_line_indicator state lexbuf                  }
+
+and end_indicator state = parse
+  blank+ { copy state lexbuf; end_indicator state lexbuf }
+| nl     { proc_nl state lexbuf                          }
+| eof    { copy state lexbuf                             }
+| "//"   { copy state lexbuf;
+           print state (message [] lexbuf ^ "\n")        }
+| '"'    { copy state lexbuf;
+           in_string (mk_reg lexbuf) state lexbuf;
+           opt_line_com state lexbuf                     }
+| _      { fail End_line_indicator state lexbuf          }
+
+and opt_line_com state = parse
+  nl     { proc_nl state lexbuf                         }
+| eof    { copy state lexbuf                            }
+| blank+ { copy state lexbuf; opt_line_com state lexbuf }
+| "//"   { print state ("//" ^ message [] lexbuf)       }
+ *)
+
+(* New lines and verbatim sequence of characters *)
+
+and skip_line state = parse
+  nl     { proc_nl state lexbuf                       }
+| blank+ { skip_line state lexbuf                     }
+| "//"   { in_line_com {state with mode=Skip} lexbuf  }
+| _      { fail No_line_comment_or_blank state lexbuf }
+| eof    { ()                                         }
+
+and message acc = parse
+  nl     { Lexing.new_line lexbuf;
+           mk_str (List.length acc) acc }
+| eof    { mk_str (List.length acc) acc }
+| _ as c { message (c::acc) lexbuf      }
+
+(* Comments *)
+
+and in_line_com state = parse
+  nl  { proc_nl state lexbuf                         }
+| eof { ()                                           }
+| _   { if state.mode = Copy then copy state lexbuf;
+        in_line_com state lexbuf                     }
+
+and reasonLIGO_com opening state = parse
+  nl   { proc_nl state lexbuf; reasonLIGO_com opening state lexbuf }
+| "*/" { copy state lexbuf                                         }
+| eof  { ()                                                        }
+| _    { copy state lexbuf; reasonLIGO_com opening state lexbuf    }
+
+and cameLIGO_com opening state = parse
+  nl   { proc_nl state lexbuf; cameLIGO_com opening state lexbuf }
+| "*)" { copy state lexbuf                                       }
+| eof  { ()                                                      }
+| _    { copy state lexbuf; cameLIGO_com opening state lexbuf    }
+
+(* Included filename *)
+
+and scan_inclusion state = parse
+  blank+ { scan_inclusion state lexbuf                    }
+| '"'    { in_inclusion (mk_reg lexbuf) [] 0 state lexbuf }
+
+and in_inclusion opening acc len state = parse
+  '"'    { let closing = mk_reg lexbuf
+           in Region.cover opening closing,
+              mk_str len acc                                  }
+| nl     { fail Newline_in_string state lexbuf                }
+| eof    { stop Open_string state opening                     }
+| _ as c { in_inclusion opening (c::acc) (len+1) state lexbuf }
+
+(* Strings *)
+
+and in_string opening state = parse
+  "\\\"" { copy state lexbuf; in_string opening state lexbuf }
+| '"'    { copy state lexbuf                                 }
+| eof    { ()                                                }
+| _      { copy state lexbuf; in_string opening state lexbuf }
+
+and preproc state = parse
+  eof { state }
+| _   { let open Lexing in
+        let ()   = rollback lexbuf in
+        let name = lexbuf.lex_start_p.pos_fname in
+        let ()   = if name <> "" then
+                     print state (sprintf "# 1 \"%s\"\n" name)
+        in scan state lexbuf }
+
+{
+  (* START OF TRAILER *)
+
+(* The function [lex] is a wrapper of [scan], which also checks that
+   the trace is empty at the end.  Note that we discard the state at
+   the end. *)
+
+let lex opt buffer =
+  let path = buffer.Lexing.lex_curr_p.Lexing.pos_fname in
+  let dir  = [Filename.dirname path] in
+  let state = {
+    env    = Env.empty;
+    mode   = Copy;
+    offset = Prefix 0;
+    trace  = [];
+    out    = Buffer.create 80;
+    incl   = [];
+    opt;
+    dir
+  } in
+  match preproc state buffer with
+    state -> List.iter close_in state.incl;
+             Stdlib.Ok state.out
+  | exception Error e -> Stdlib.Error e
+
+(* END OF TRAILER *)
+}

vendors/Preprocessor/PreprocMain.ml

@@ -0,0 +1,35 @@
+(* Standalone preprocessor for PascaLIGO *)
+
+module Region  = Simple_utils.Region
+module Preproc = Preprocessor.Preproc
+module EvalOpt = Preprocessor.EvalOpt
+
+let highlight msg = Printf.eprintf "\027[31m%s\027[0m\n%!" msg
+
+let options = EvalOpt.(read ~lang:`PascaLIGO ~ext:".ligo")
+
+let preproc cin =
+  let buffer = Lexing.from_channel cin in
+  let open Lexing in
+  let () =
+    match options#input with
+      None -> ()
+    | Some pos_fname ->
+        buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} in
+  match Preproc.lex options buffer with
+    Stdlib.Ok pp_buffer -> print_string (Buffer.contents pp_buffer)
+  | Stdlib.Error (pp_buffer, err) ->
+      let formatted =
+        Preproc.format ~offsets:options#offsets ~file:true err in
+      begin
+        if EvalOpt.SSet.mem "preproc" options#verbose then
+          Printf.printf "%s\n%!" (Buffer.contents pp_buffer);
+        highlight formatted.Region.value
+      end
+
+let () =
+  match options#input with
+    None -> preproc stdin
+  | Some file_path ->
+     try open_in file_path |> preproc with
+       Sys_error msg -> highlight msg

vendors/Preprocessor/Preprocessor.ml

@@ -0,0 +1,2 @@
+module Preproc = Preproc
+module EvalOpt = EvalOpt

vendors/Preprocessor/Preprocessor.opam

@@ -0,0 +1,15 @@
+opam-version : "2.0"
+name         : "Preprocessor"
+version      : "1.0"
+synopsis     : "A C#-like preprocessor for LIGO"
+description  : "The following preprocessing directives are supported: #define,  #elif, #else, #endif, #endregion, #error, #if, #include, #region, #undef."
+maintainer   : "rinderknecht@free.fr"
+authors      : "Christian Rinderknecht"
+license      : "MIT"
+homepage     : "https://gitlab.com/ligolang/Preprocessor"
+bug-reports  : "https://gitlab.com/ligolang/ligo-utils/issues"
+depends      : ["dune" "base" "ocaml" "simple-utils"]
+build        : [
+                [ "sh" "-c" "printf 'let version = \"%s\"' \"$(git describe --always --dirty --abbrev=0)\" > Version.ml" ]
+                [ "dune" "build" "-p" name "-j" jobs ]
+               ]

vendors/Preprocessor/README.md

@@ -0,0 +1,21 @@
+# A preprocessor a la C# in OCaml
+
+The following preprocessing directives are supported
+  * #define
+  * #elif
+  * #else
+  * #endif
+  * #endregion
+  * #error
+  * #if
+  * #include
+  * #region
+  * #undef
+
+Note: Because it is meant for LIGO, there is no error raised for
+invalid preprocessing directives, as the symbol `#` is valid in
+PascaLIGO (cons operator for lists). Also, the preprocessor may report an error on some weird but valid PascaLIGO contracts, like
+
+const include : list (int) = list [1]
+const l : list (int) = 0
+# include

vendors/Preprocessor/build.sh

@@ -0,0 +1,22 @@
+#!/bin/sh
+set -x
+ocamllex.opt E_Lexer.mll
+ocamllex.opt Preproc.mll
+menhir -la 1 E_Parser.mly
+ocamlfind ocamlc -strict-sequence -w +A-48-4 -c EvalOpt.mli
+ocamlfind ocamlc -strict-sequence -w +A-48-4 -c E_AST.ml
+ocamlfind ocamlc -strict-sequence -w +A-48-4 -c E_Parser.mli
+ocamlfind ocamlc -strict-sequence -w +A-48-4 -package simple-utils -c E_Lexer.mli
+ocamlfind ocamlc -strict-sequence -w +A-48-4 -package simple-utils -c E_LexerMain.ml
+camlcmd="ocamlfind ocamlc -I _x86_64 -strict-sequence -w +A-48-4   "
+ocamlfind ocamlc -strict-sequence -w +A-48-4 -package getopt,str -c EvalOpt.ml
+ocamlfind ocamlc -strict-sequence -w +A-48-4 -package simple-utils -c E_Lexer.ml
+menhir --infer --ocamlc="$camlcmd" E_Parser.mly
+ocamlfind ocamlc -strict-sequence -w +A-48-4 -c E_Parser.ml
+ocamlfind ocamlc -package getopt,simple-utils,str -linkpkg -o E_LexerMain.byte E_AST.cmo E_Parser.cmo E_Lexer.cmo EvalOpt.cmo E_LexerMain.cmo
+ocamlfind ocamlc -strict-sequence -w +A-48-4 -package simple-utils -c Preproc.mli
+ocamlfind ocamlc -strict-sequence -w +A-48-4 -package simple-utils -c PreprocMain.ml
+ocamlfind ocamlc -strict-sequence -w +A-48-4 -package simple-utils -c Preproc.ml
+ocamlfind ocamlc -package getopt,simple-utils,str -linkpkg -o PreprocMain.byte EvalOpt.cmo E_AST.cmo E_Parser.cmo E_Lexer.cmo Preproc.cmo PreprocMain.cmo
+ocamlfind ocamlc -strict-sequence -w +A-48-4 -package simple-utils -c E_ParserMain.ml
+ocamlfind ocamlc -package getopt,simple-utils,str -linkpkg -o E_ParserMain.byte E_AST.cmo E_Parser.cmo E_Lexer.cmo EvalOpt.cmo Preproc.cmo E_ParserMain.cmo

vendors/Preprocessor/clean.sh

@@ -0,0 +1,4 @@
+#!/bin/sh
+
+\rm -f *.cm* *.o *.byte *.opt
+\rm E_Lexer.ml E_Parser.ml E_Parser.mli Preproc.ml

vendors/Preprocessor/dune

@@ -0,0 +1,51 @@
+;; Building the preprocessor as a library
+
+(library
+  (name Preprocessor)
+  (public_name Preprocessor)
+  (wrapped true)
+  (libraries
+     getopt
+     simple-utils)
+  (modules EvalOpt E_Parser E_Lexer E_AST Preproc)
+  (preprocess
+    (pps bisect_ppx --conditional)))
+
+;; Building the lexers of the preprocessor
+
+(ocamllex
+   E_Lexer Preproc)
+
+;; Building the parser of the preprocessor (for boolean expressions)
+
+(menhir
+  (modules E_Parser))
+
+;; Building PreprocMain.exe for a standalone preprocessor
+
+(executable
+  (name PreprocMain)
+  (modules PreprocMain)
+  (libraries Preprocessor)
+  (preprocess
+    (pps bisect_ppx --conditional)))
+
+;; Building E_LexerMain.exe for a standalone lexer of boolean
+;; expressions
+
+(executable
+  (name E_LexerMain)
+  (modules E_LexerMain)
+  (libraries Preproc)
+  (preprocess
+    (pps bisect_ppx --conditional)))
+
+;; Building E_ParserMain.exe for a standalone parser of boolean
+;; expressions
+
+(executable
+  (name E_ParserMain)
+  (modules E_ParserMain)
+  (libraries Preproc)
+  (preprocess
+    (pps bisect_ppx --conditional)))

vendors/Preprocessor/dune-project

@@ -0,0 +1,2 @@
+(lang dune 1.7)
+(using menhir 2.0)