From b24f1f6b1df3152b089bdab4732bea621aeb49f1 Mon Sep 17 00:00:00 2001
From: Christian Rinderknecht <Christian.Rinderknecht@tezcore.com>
Date: Wed, 25 Mar 2020 18:52:23 +0100
Subject: [PATCH] Added support for -I CLI option (same behaviour as CPP).
 Comments are now recognised in accordance with the file extension.

---
 vendors/Preproc/EvalOpt.ml     |   2 +-
 vendors/Preproc/Preproc.mli    |   3 +-
 vendors/Preproc/Preproc.mll    | 145 +++++++++++++++++++++------------
 vendors/Preproc/PreprocMain.ml |   8 +-
 4 files changed, 99 insertions(+), 59 deletions(-)

diff --git a/vendors/Preproc/EvalOpt.ml b/vendors/Preproc/EvalOpt.ml
index 99ffbe8bf..ea21bff44 100644
--- a/vendors/Preproc/EvalOpt.ml
+++ b/vendors/Preproc/EvalOpt.ml
@@ -41,7 +41,7 @@ let help () =
   printf "Usage: %s [<option> ...] <input>\n" file;
   printf "where <input> is the source file,\n";
   print "and each <option> (if any) is one of the following:";
-  print "  -I <paths>             Library paths (colon-separated)";
+  print "  -I <paths>             Inclusion paths (colon-separated)";
   print "             --columns   Columns for source locations";
   print "  -h,        --help      This help";
   exit 0
diff --git a/vendors/Preproc/Preproc.mli b/vendors/Preproc/Preproc.mli
index 0cb0929b6..8adbb2d39 100644
--- a/vendors/Preproc/Preproc.mli
+++ b/vendors/Preproc/Preproc.mli
@@ -33,6 +33,7 @@ type error =
 | Parse_error
 | No_line_comment_or_blank
 | Invalid_symbol
+| File_not_found of string
 
 val format :
   ?offsets:bool -> error Region.reg -> file:bool -> string Region.reg
@@ -41,7 +42,7 @@ val format :
 
 exception Error of Buffer.t * error Region.reg
 
-val lex : Lexing.lexbuf -> Buffer.t
+val lex : EvalOpt.options -> Lexing.lexbuf -> Buffer.t
 
 (* Evaluation of boolean expressions *)
 
diff --git a/vendors/Preproc/Preproc.mll b/vendors/Preproc/Preproc.mll
index a4585852c..60495c20c 100644
--- a/vendors/Preproc/Preproc.mll
+++ b/vendors/Preproc/Preproc.mll
@@ -73,7 +73,8 @@ type state = {
   offset : offset;
   trace  : trace;
   out    : Buffer.t;
-  incl   : in_channel list
+  incl   : in_channel list;
+  opt    : EvalOpt.options
 }
 
 (* ERRORS *)
@@ -103,6 +104,7 @@ type error =
 | Parse_error
 | No_line_comment_or_blank
 | Invalid_symbol
+| File_not_found of string
 
 let error_to_string = function
   Invalid_directive name ->
@@ -163,6 +165,8 @@ let error_to_string = function
     "Line comment or whitespace expected."
 | Invalid_symbol ->
     "Expected a symbol (identifier)."
+| File_not_found name ->
+    sprintf "File \"%s\" to include not found." name
 
 let format ?(offsets=true) Region.{region; value} ~file =
   let msg   = error_to_string value
@@ -186,18 +190,18 @@ let fail error state buffer = stop error state (mk_reg buffer)
 let reduce_cond state region =
   let rec reduce = function
                 [] -> stop Dangling_endif state region
-  | If mode::trace -> trace, mode
+  | 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_reg] is called when a #endregion directive is
+(* The function [reduce_region] is called when a #endregion directive is
    read, and the trace needs updating. *)
 
-let reduce_reg state region =
+let reduce_region state region =
   match state.trace with
                [] -> stop Dangling_endregion state region
-  | Region::trace -> trace
+  | Region::trace -> {state with trace; offset = Prefix 0}
   |             _ -> stop Conditional_in_region state region
 
 (* The function [extend] is called when encountering conditional
@@ -222,6 +226,22 @@ let rec last_mode = function
 | (If mode | Elif mode)::_ -> mode
 |                 _::trace -> last_mode trace
 
+(* Finding a file to #include *)
+
+let rec find base = function
+         [] -> None
+| dir::dirs ->
+    let path = dir ^ Filename.dir_sep ^ base in
+    try Some (open_in path) with
+      Sys_error _ -> find base dirs
+
+let find dir file libs : in_channel option =
+  let path = dir ^ Filename.dir_sep ^ file in
+  try Some (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] *)
@@ -267,9 +287,9 @@ let expr state buffer : mode =
 (* DIRECTIVES *)
 
 let directives = [
-  "if"; "else"; "elif"; "endif"; "define"; "undef";
-  "error"; (*"warning";*) "line"; "region"; "endregion";
-  "include"]
+  "define"; "elif"; "else"; "endif"; "endregion"; "error";
+  "if"; "include"; "line"; "region"; "undef" (* "warning" *)
+]
 
 (* END OF HEADER *)
 }
@@ -303,10 +323,10 @@ let directive = '#' (blank* as space) (small+ as id)
    directives read so far.
 
    The first call is [scan {env=Env.empty; mode=Copy; offset = Prefix
-   0; trace=[]}], 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.
+   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
@@ -405,7 +425,7 @@ let directive = '#' (blank* as space) (small+ as id)
    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    { proc_nl state lexbuf;
@@ -422,14 +442,18 @@ rule scan state = parse
     match id with
       "include" ->
         let line = Lexing.(lexbuf.lex_curr_p.pos_lnum)
-        and file = Lexing.(lexbuf.lex_curr_p.pos_fname)
-                   |> Filename.basename
-        and incl_file = scan_inclusion state lexbuf in
+        and file = Lexing.(lexbuf.lex_curr_p.pos_fname) in
+        let base = Filename.basename file
+        and dir  = Filename.dirname file
+        and reg, incl_file = scan_inclusion state lexbuf in
         print state (sprintf "# 1 \"%s\" 1\n" incl_file);
-        let incl_chan = open_in incl_file in
+        let incl_chan =
+          match find dir incl_file state.opt#libs with
+            Some channel -> channel
+          | None -> stop (File_not_found incl_file) state reg in
         let state = {state with incl = incl_chan::state.incl} in
         cat state (Lexing.from_channel incl_chan);
-        print state (sprintf "# %i \"%s\" 2\n" (line+1) file);
+        print state (sprintf "# %i \"%s\" 2" (line+1) base);
         scan state lexbuf
     | "if" ->
         let mode  = expr state lexbuf in
@@ -454,9 +478,8 @@ rule scan state = parse
                        if old_mode = Copy then mode else Skip
         in scan {state with mode; offset = Prefix 0; trace} lexbuf
     | "endif" ->
-        let () = skip_line state lexbuf in
-        let trace, mode = reduce_cond state region
-        in scan {state with mode; offset = Prefix 0; trace} lexbuf
+        skip_line state lexbuf;
+        scan (reduce_cond state region) lexbuf
     | "define" ->
         let id, region = variable state lexbuf in
         if id="true" || id="false"
@@ -497,10 +520,7 @@ rule scan state = parse
         let msg = message [] lexbuf
         in expand_offset state;
            print state ("#" ^ space ^ "endregion" ^ msg ^ "\n");
-           let state =
-             {state with offset = Prefix 0;
-                         trace  = reduce_reg state region}
-           in scan state lexbuf
+           scan (reduce_region state region) lexbuf
     | "line" ->
         expand_offset state;
         print state ("#" ^ space ^ "line");
@@ -529,7 +549,17 @@ rule scan state = parse
             begin
               expand_offset state;
               copy state lexbuf;
-              in_block_com (mk_reg lexbuf) state lexbuf
+              if state.opt#lang = EvalOpt.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 = EvalOpt.CameLIGO
+               || state.opt#lang = EvalOpt.PascaLIGO then
+                cameLIGO_com (mk_reg lexbuf) state lexbuf
             end;
           scan {state with offset=Inline} lexbuf }
 | _     { if state.mode = Copy then
@@ -546,7 +576,7 @@ and variable state = parse
            in skip_line state lexbuf; id }
 
 and symbol state = parse
-  ident as id { id, mk_reg lexbuf                      }
+  ident as id { id, mk_reg lexbuf                }
 | _           { fail Invalid_symbol state lexbuf }
 
 
@@ -561,19 +591,19 @@ and line_indicator state = parse
     match id with
       "default" | "hidden" ->
         print state (id ^ message [] lexbuf)
-    | _ -> fail (Invalid_line_indicator id) state lexbuf }
-| _ { fail No_line_indicator state 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                              }
+  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")         }
+           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     }
+           opt_line_com state lexbuf                     }
+| _      { fail End_line_indicator state lexbuf          }
 
 and opt_line_com state = parse
   nl     { proc_nl state lexbuf                         }
@@ -584,11 +614,11 @@ and opt_line_com state = parse
 (* 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        }
+  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    { ()                                               }
+| eof    { ()                                         }
 
 and message acc = parse
   nl     { Lexing.new_line lexbuf;
@@ -604,11 +634,17 @@ and in_line_com state = parse
 | _   { if state.mode = Copy then copy state lexbuf;
         in_line_com state lexbuf                     }
 
-and in_block_com opening state = parse
-  nl   { proc_nl state lexbuf; in_block_com opening state lexbuf }
+and reasonLIGO_com opening state = parse
+  nl   { proc_nl state lexbuf; reasonLIGO_com opening state lexbuf }
 | "*/" { copy state lexbuf                                       }
-| eof  { stop Open_comment state opening                   }
-| _    { copy state lexbuf; in_block_com opening state lexbuf    }
+| eof  { stop Open_comment state opening                         }
+| _    { 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  { stop Open_comment state opening                         }
+| _    { copy state lexbuf; cameLIGO_com opening state lexbuf    }
 
 (* Include a file *)
 
@@ -623,19 +659,21 @@ and scan_inclusion state = parse
 | '"'    { in_inclusion (mk_reg lexbuf) [] 0 state lexbuf }
 
 and in_inclusion opening acc len state = parse
-  '"'    { mk_str len acc                                     }
-| nl     { fail Newline_in_string state lexbuf          }
-| eof    { stop Open_string state opening               }
+  '"'    { 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                                  }
-| nl     { fail Newline_in_string state lexbuf          }
-| eof    { stop Open_string state opening               }
-| _      { copy state lexbuf; in_string opening state lexbuf  }
+  "\\\"" { copy state lexbuf; in_string opening state lexbuf }
+| '"'    { copy state lexbuf                                 }
+| nl     { fail Newline_in_string state lexbuf               }
+| eof    { stop Open_string state opening                    }
+| _      { copy state lexbuf; in_string opening state lexbuf }
 
 
 {
@@ -645,14 +683,15 @@ and in_string opening state = parse
    the trace is empty at the end.  Note that we discard the state at
    the end. *)
 
-let lex buffer : Buffer.t =
+let lex opt buffer : Buffer.t =
   let state = {
     env    = Env.empty;
     mode   = Copy;
     offset = Prefix 0;
     trace  = [];
     out    = Buffer.create 80;
-    incl   = []
+    incl   = [];
+    opt
   } in
   let state = scan state buffer in
   let () = List.iter close_in state.incl
diff --git a/vendors/Preproc/PreprocMain.ml b/vendors/Preproc/PreprocMain.ml
index a07eed957..175331dca 100644
--- a/vendors/Preproc/PreprocMain.ml
+++ b/vendors/Preproc/PreprocMain.ml
@@ -1,6 +1,6 @@
 module Region = Simple_utils.Region
 
-let highlight msg = Printf.eprintf "\027[31m%s\027[0m%!" msg
+let highlight msg = Printf.eprintf "\027[31m%s\027[0m\n%!" msg
 
 let options = EvalOpt.read ();;
 
@@ -12,16 +12,16 @@ match open_in options#input with
     let () =
       buffer.lex_curr_p <-
         {buffer.lex_curr_p with pos_fname = options#input} in
-    match Preproc.lex buffer with
+    match Preproc.lex options buffer with
       pp -> print_string (Buffer.contents pp)
     | exception E_Lexer.Error err ->
         let formatted =
           E_Lexer.format ~offsets:options#offsets ~file:true err
         in highlight formatted.Region.value
-    | exception Preproc.Error (out, err) ->
+    | exception Preproc.Error (_out, err) ->
         let formatted =
           Preproc.format ~offsets:options#offsets ~file:true err in
         begin
-          print_string (Buffer.contents out);
+(*          print_string (Buffer.contents out);*)
           highlight formatted.Region.value
         end