From 3ed303f60dd8b5ccf763d8bf564448613821a67d Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Thu, 9 Apr 2020 16:18:26 +0200 Subject: [PATCH] In EvalOpt modules, the CLI input ["-"] is becomes now [None], like the absence of an input filename. (This simplifies all the clients codes.) Fixed the dune file for the preprocessor. Fixed the build of PreprocMain.exe and PreprocMain.byte. Restricted preprocessing errors [Preproc.Newline_in_string] and [Preproc.Open_string] to the argument of the #include directive (instead of general strings: this is for the LIGO lexer to report the error). I removed the error [Preproc.Open_comment] as this is for the LIGO lexer to report. The preprocessor scanner [Preproc.lex] does not take a parameter [is_file:bool] now: the source file (if any) is determined from the lexing buffer. Accordingly, the field [is_file] of the state of the preprocessing lexer has been removed: the lexing buffer becomes now the reference for the input source (bug fix and interface improvement). Fixed the comments of the test contract pledge.religo. I removed the data constructor [Lexer.Stdin], as redundant with [Lexer.Channel]. --- src/bin/expect_tests/literals.ml | 4 +- src/passes/1-parser/cameligo/ParserMain.ml | 6 +- src/passes/1-parser/pascaligo/ParserMain.ml | 6 +- src/passes/1-parser/reasonligo/ParserMain.ml | 6 +- src/passes/1-parser/shared/EvalOpt.ml | 2 +- src/passes/1-parser/shared/Lexer.mli | 5 +- src/passes/1-parser/shared/Lexer.mll | 22 ++---- src/passes/1-parser/shared/LexerLog.ml | 6 +- src/passes/1-parser/shared/LexerUnit.ml | 70 ++++++++++---------- src/passes/1-parser/shared/ParserUnit.ml | 25 ++++--- src/test/contracts/pledge.religo | 8 +-- vendors/Preprocessor/EvalOpt.ml | 2 +- vendors/Preprocessor/Preproc.mli | 6 +- vendors/Preprocessor/Preproc.mll | 29 ++++---- vendors/Preprocessor/PreprocMain.ml | 8 ++- vendors/Preprocessor/Preprocessor.install | 35 ---------- vendors/Preprocessor/dune | 2 +- 17 files changed, 91 insertions(+), 151 deletions(-) delete mode 100644 vendors/Preprocessor/Preprocessor.install diff --git a/src/bin/expect_tests/literals.ml b/src/bin/expect_tests/literals.ml index 88685acc5..da8a4333d 100644 --- a/src/bin/expect_tests/literals.ml +++ b/src/bin/expect_tests/literals.ml @@ -7,7 +7,7 @@ let%expect_test _ = let%expect_test _ = run_ligo_bad ["interpret" ; "(\"thisisnotasignature\":signature)" ; "--syntax=pascaligo"] ; [%expect {| - ligo: in file ".", line 1, characters 1-32. Badly formatted literal: Signature thisisnotasignature {"location":"in file \".\", line 1, characters 1-32"} + ligo: in file "", line 0, characters 1-32. Badly formatted literal: Signature thisisnotasignature {"location":"in file \"\", line 0, characters 1-32"} If you're not sure how to fix this error, you can @@ -25,7 +25,7 @@ let%expect_test _ = let%expect_test _ = run_ligo_bad ["interpret" ; "(\"thisisnotapublickey\":key)" ; "--syntax=pascaligo"] ; [%expect {| - ligo: in file ".", line 1, characters 1-26. Badly formatted literal: key thisisnotapublickey {"location":"in file \".\", line 1, characters 1-26"} + ligo: in file "", line 0, characters 1-26. Badly formatted literal: key thisisnotapublickey {"location":"in file \"\", line 0, characters 1-26"} If you're not sure how to fix this error, you can diff --git a/src/passes/1-parser/cameligo/ParserMain.ml b/src/passes/1-parser/cameligo/ParserMain.ml index d2908a362..bc47d9199 100644 --- a/src/passes/1-parser/cameligo/ParserMain.ml +++ b/src/passes/1-parser/cameligo/ParserMain.ml @@ -72,7 +72,5 @@ let wrap = function let () = match IO.options#input with - Some "-" | None -> - Unit.contract_in_stdin () |> wrap - | Some file_path -> - Unit.contract_in_file file_path |> wrap + None -> Unit.contract_in_stdin () |> wrap + | Some file_path -> Unit.contract_in_file file_path |> wrap diff --git a/src/passes/1-parser/pascaligo/ParserMain.ml b/src/passes/1-parser/pascaligo/ParserMain.ml index a607dd3ba..c94ca806d 100644 --- a/src/passes/1-parser/pascaligo/ParserMain.ml +++ b/src/passes/1-parser/pascaligo/ParserMain.ml @@ -72,7 +72,5 @@ let wrap = function let () = match IO.options#input with - Some "-" | None -> - Unit.contract_in_stdin () |> wrap - | Some file_path -> - Unit.contract_in_file file_path |> wrap + None -> Unit.contract_in_stdin () |> wrap + | Some file_path -> Unit.contract_in_file file_path |> wrap diff --git a/src/passes/1-parser/reasonligo/ParserMain.ml b/src/passes/1-parser/reasonligo/ParserMain.ml index 72fb453ba..82ffc7b32 100644 --- a/src/passes/1-parser/reasonligo/ParserMain.ml +++ b/src/passes/1-parser/reasonligo/ParserMain.ml @@ -72,7 +72,5 @@ let wrap = function let () = match IO.options#input with - Some "-" | None -> - Unit.contract_in_stdin () |> wrap - | Some file_path -> - Unit.contract_in_file file_path |> wrap + None -> Unit.contract_in_stdin () |> wrap + | Some file_path -> Unit.contract_in_file file_path |> wrap diff --git a/src/passes/1-parser/shared/EvalOpt.ml b/src/passes/1-parser/shared/EvalOpt.ml index 15ddfc2e6..54d971846 100644 --- a/src/passes/1-parser/shared/EvalOpt.ml +++ b/src/passes/1-parser/shared/EvalOpt.ml @@ -162,7 +162,7 @@ let check lang ext = let input = match !input with - None | Some "-" -> !input + None | Some "-" -> None | Some file_path -> if Filename.check_suffix file_path ext then if Sys.file_exists file_path diff --git a/src/passes/1-parser/shared/Lexer.mli b/src/passes/1-parser/shared/Lexer.mli index 6435d48d2..60e3be89b 100644 --- a/src/passes/1-parser/shared/Lexer.mli +++ b/src/passes/1-parser/shared/Lexer.mli @@ -136,14 +136,11 @@ module type S = val slide : token -> window -> window type input = - File of file_path (* "-" means stdin *) - | Stdin + File of file_path | String of string | Channel of in_channel | Buffer of Lexing.lexbuf - val is_file : input -> bool - type instance = { input : input; read : log:logger -> Lexing.lexbuf -> token; diff --git a/src/passes/1-parser/shared/Lexer.mll b/src/passes/1-parser/shared/Lexer.mll index 59ec4a1ba..a67e438c8 100644 --- a/src/passes/1-parser/shared/Lexer.mll +++ b/src/passes/1-parser/shared/Lexer.mll @@ -158,14 +158,11 @@ module type S = val slide : token -> window -> window type input = - File of file_path (* "-" means stdin *) - | Stdin + File of file_path | String of string | Channel of in_channel | Buffer of Lexing.lexbuf - val is_file : input -> bool - type instance = { input : input; read : log:logger -> Lexing.lexbuf -> token; @@ -940,19 +937,11 @@ and scan_utf8_inline thread state = parse type logger = Markup.t list -> token -> unit type input = - File of file_path (* "-" means stdin *) -| Stdin + File of file_path | String of string | Channel of in_channel | Buffer of Lexing.lexbuf -(* Checking if a lexer input is a file *) - -let is_file = function - File "-" | File "" -> false - | File _ -> true - | Stdin | String _ | Channel _ | Buffer _ -> false - type instance = { input : input; read : log:logger -> Lexing.lexbuf -> token; @@ -967,9 +956,7 @@ type instance = { type open_err = File_opening of string let lexbuf_from_input = function - File "" | File "-" | Stdin -> - Ok (Lexing.from_channel stdin, fun () -> close_in stdin) -| File path -> + File path -> (try let chan = open_in path in let close () = close_in chan in @@ -988,8 +975,7 @@ let lexbuf_from_input = function 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) diff --git a/src/passes/1-parser/shared/LexerLog.ml b/src/passes/1-parser/shared/LexerLog.ml index c338efe23..1f978f6b2 100644 --- a/src/passes/1-parser/shared/LexerLog.ml +++ b/src/passes/1-parser/shared/LexerLog.ml @@ -69,12 +69,8 @@ module Make (Lexer: Lexer.S) : (S with module Lexer = Lexer) = then Stdlib.Ok () else iter () | exception Lexer.Error error -> - let file = - match input with - Lexer.File name -> name <> "-" - | _ -> false 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 diff --git a/src/passes/1-parser/shared/LexerUnit.ml b/src/passes/1-parser/shared/LexerUnit.ml index 04ec04feb..07837766c 100644 --- a/src/passes/1-parser/shared/LexerUnit.ml +++ b/src/passes/1-parser/shared/LexerUnit.ml @@ -20,16 +20,16 @@ module Make (IO: IO) (Lexer: Lexer.S) = let scan () : (Lexer.token list, string Region.reg) Stdlib.result = (* Preprocessing the input source *) - let preproc ~is_file cin = + 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 + 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 ~is_file opt buffer with + 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); @@ -39,33 +39,35 @@ module Make (IO: IO) (Lexer: Lexer.S) = | Stdlib.Ok pp_buffer -> (* Running the lexer on the preprocessed input *) - 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 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 + 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 - Some "-" | None -> preproc ~is_file:false stdin + None -> preproc stdin | Some file_path -> - try open_in file_path |> preproc ~is_file:true with + try open_in file_path |> preproc with Sys_error msg -> Stdlib.Error (Region.wrap_ghost msg) (* Tracing the lexing *) @@ -74,7 +76,7 @@ module Make (IO: IO) (Lexer: Lexer.S) = let trace () : (unit, string Region.reg) Stdlib.result = (* Preprocessing the input *) - let preproc ~is_file cin = + let preproc cin = let buffer = Lexing.from_channel cin in let open Lexing in let () = @@ -83,7 +85,7 @@ module Make (IO: IO) (Lexer: Lexer.S) = | 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 ~is_file opt buffer with + 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); @@ -103,8 +105,8 @@ module Make (IO: IO) (Lexer: Lexer.S) = (Lexer.String preproc_str) IO.options#cmd in match IO.options#input with - Some "-" | None -> preproc ~is_file:false stdin + None -> preproc stdin | Some file_path -> - try open_in file_path |> preproc ~is_file:true with + try open_in file_path |> preproc with Sys_error msg -> Stdlib.Error (Region.wrap_ghost msg) end diff --git a/src/passes/1-parser/shared/ParserUnit.ml b/src/passes/1-parser/shared/ParserUnit.ml index a32030a7b..f1d495157 100644 --- a/src/passes/1-parser/shared/ParserUnit.ml +++ b/src/passes/1-parser/shared/ParserUnit.ml @@ -163,10 +163,11 @@ module Make (Lexer: Lexer.S) (* Lexing errors *) | exception Lexer.Error err -> - let file = Lexer.is_file lexer_inst.Lexer.input in + let file = + lexer_inst.Lexer.buffer.Lexing.lex_curr_p.Lexing.pos_fname in let error = Lexer.format_error ~offsets:SubIO.options#offsets - SubIO.options#mode err ~file + SubIO.options#mode err ~file:(file <> "") in Stdlib.Error error (* Incremental API of Menhir *) @@ -199,8 +200,8 @@ module Make (Lexer: Lexer.S) (* Preprocessing the input source *) - let preproc ~is_file options lexbuf = - Preproc.lex ~is_file (options :> Preprocessor.EvalOpt.options) lexbuf + let preproc options lexbuf = + Preproc.lex (options :> Preprocessor.EvalOpt.options) lexbuf (* Parsing a contract *) @@ -210,14 +211,14 @@ module Make (Lexer: Lexer.S) Stdlib.Error (Region.wrap_ghost msg) | Ok (lexbuf, close) -> (* Preprocessing the input source *) - - match preproc ~is_file:(Lexer.is_file input) options lexbuf with + 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:(Lexer.is_file input) + ~file:(file <> "") err in close (); Stdlib.Error formatted | Stdlib.Ok buffer -> @@ -226,7 +227,11 @@ module Make (Lexer: Lexer.S) let () = close () in let input' = Lexer.String (Buffer.contents buffer) in match Lexer.open_token_stream options#lang input' with - Ok instance -> apply instance parser + 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) @@ -246,7 +251,7 @@ module Make (Lexer: Lexer.S) let contract_in_stdin () = let options = SubIO.make ~input:None ~expr:false in - gen_parser options Lexer.Stdin parse_contract + gen_parser options (Lexer.Channel stdin) parse_contract (* Parsing an expression in a string *) @@ -258,6 +263,6 @@ module Make (Lexer: Lexer.S) let expr_in_stdin () = let options = SubIO.make ~input:None ~expr:true in - gen_parser options Lexer.Stdin parse_expr + gen_parser options (Lexer.Channel stdin) parse_expr end diff --git a/src/test/contracts/pledge.religo b/src/test/contracts/pledge.religo index 394435397..14024f292 100644 --- a/src/test/contracts/pledge.religo +++ b/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 diff --git a/vendors/Preprocessor/EvalOpt.ml b/vendors/Preprocessor/EvalOpt.ml index cc658c0dc..63c92fad1 100644 --- a/vendors/Preprocessor/EvalOpt.ml +++ b/vendors/Preprocessor/EvalOpt.ml @@ -101,7 +101,7 @@ let check lang ext = and input = match !input with - None | Some "-" -> !input + None | Some "-" -> None | Some file_path -> if Filename.check_suffix file_path ext then if Sys.file_exists file_path diff --git a/vendors/Preprocessor/Preproc.mli b/vendors/Preprocessor/Preproc.mli index 56ddc8c64..3297c23cc 100644 --- a/vendors/Preprocessor/Preproc.mli +++ b/vendors/Preprocessor/Preproc.mli @@ -14,9 +14,8 @@ type error = | Invalid_line_indicator of string | No_line_indicator | End_line_indicator -| Newline_in_string (*XXX*) -| Open_comment (*XXX*) -| Open_string (*XXX*) +| Newline_in_string (* For #include argument only *) +| Open_string (* For #include argument only *) | Dangling_endif | Open_region_in_conditional | Dangling_endregion @@ -41,7 +40,6 @@ val format : (* Preprocessing a lexing buffer *) val lex : - is_file:bool -> EvalOpt.options -> Lexing.lexbuf -> (Buffer.t, Buffer.t * error Region.reg) Stdlib.result diff --git a/vendors/Preprocessor/Preproc.mll b/vendors/Preprocessor/Preproc.mll index 956919933..fccc8ee6f 100644 --- a/vendors/Preprocessor/Preproc.mll +++ b/vendors/Preprocessor/Preproc.mll @@ -97,8 +97,7 @@ type state = { out : Buffer.t; incl : in_channel list; opt : EvalOpt.options; - dir : string list; - is_file : bool + dir : string list } (* Directories *) @@ -118,7 +117,6 @@ type error = | No_line_indicator | End_line_indicator | Newline_in_string -| Open_comment | Open_string | Dangling_endif | Open_region_in_conditional @@ -153,8 +151,6 @@ let error_to_string = function Hint: Try a string, end of line, or a line comment." | Newline_in_string -> sprintf "Invalid newline character in string." -| Open_comment -> - sprintf "Unterminated comment." | Open_string -> sprintf "Unterminated string.\n\ Hint: Close with double quotes." @@ -704,13 +700,13 @@ and in_line_com state = parse 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 } +| 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 { stop Open_comment state opening } +| eof { () } | _ { copy state lexbuf; cameLIGO_com opening state lexbuf } (* Included filename *) @@ -732,17 +728,17 @@ and in_inclusion opening acc len state = parse 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 } +| eof { () } | _ { copy state lexbuf; in_string opening state lexbuf } and preproc state = parse eof { state } -| _ { rollback lexbuf; - if state.is_file then - print state (sprintf "# 1 \"%s\"\n" - Lexing.(lexbuf.lex_start_p.pos_fname)); - scan state lexbuf } +| _ { 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 *) @@ -751,7 +747,7 @@ and preproc state = parse the trace is empty at the end. Note that we discard the state at the end. *) -let lex ~is_file opt buffer = +let lex opt buffer = let state = { env = Env.empty; mode = Copy; @@ -760,8 +756,7 @@ let lex ~is_file opt buffer = out = Buffer.create 80; incl = []; opt; - dir = []; - is_file; + dir = [] } in match preproc state buffer with state -> List.iter close_in state.incl; diff --git a/vendors/Preprocessor/PreprocMain.ml b/vendors/Preprocessor/PreprocMain.ml index b8418a878..ba360d605 100644 --- a/vendors/Preprocessor/PreprocMain.ml +++ b/vendors/Preprocessor/PreprocMain.ml @@ -1,6 +1,8 @@ (* Standalone preprocessor for PascaLIGO *) -module Region = Simple_utils.Region +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 @@ -11,7 +13,7 @@ let preproc cin = let open Lexing in let () = match options#input with - None | Some "-" -> () + None -> () | Some pos_fname -> buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} in match Preproc.lex options buffer with @@ -27,7 +29,7 @@ let preproc cin = let () = match options#input with - Some "-" | None -> preproc stdin + None -> preproc stdin | Some file_path -> try open_in file_path |> preproc with Sys_error msg -> highlight msg diff --git a/vendors/Preprocessor/Preprocessor.install b/vendors/Preprocessor/Preprocessor.install deleted file mode 100644 index a4624cc33..000000000 --- a/vendors/Preprocessor/Preprocessor.install +++ /dev/null @@ -1,35 +0,0 @@ -lib: [ - "_build/install/default/lib/Preprocessor/META" - "_build/install/default/lib/Preprocessor/E_Lexer.mli" - "_build/install/default/lib/Preprocessor/E_Lexer.mll" - "_build/install/default/lib/Preprocessor/EvalOpt.mli" - "_build/install/default/lib/Preprocessor/EvalOpt.ml" - "_build/install/default/lib/Preprocessor/Preproc.mli" - "_build/install/default/lib/Preprocessor/Preproc.mll" - "_build/install/default/lib/Preprocessor/E_AST.ml" - "_build/install/default/lib/Preprocessor/Preprocessor.a" - "_build/install/default/lib/Preprocessor/Preprocessor.cma" - "_build/install/default/lib/Preprocessor/Preprocessor.cmxa" - "_build/install/default/lib/Preprocessor/Preprocessor.cmxs" - "_build/install/default/lib/Preprocessor/dune-package" - "_build/install/default/lib/Preprocessor/opam" - "_build/install/default/lib/Preprocessor/Preprocessor.cmi" - "_build/install/default/lib/Preprocessor/Preprocessor.cmt" - "_build/install/default/lib/Preprocessor/Preprocessor.cmx" - "_build/install/default/lib/Preprocessor/Preprocessor__E_Lexer.cmi" - "_build/install/default/lib/Preprocessor/Preprocessor__E_Lexer.cmt" - "_build/install/default/lib/Preprocessor/Preprocessor__E_Lexer.cmx" - "_build/install/default/lib/Preprocessor/Preprocessor__EvalOpt.cmi" - "_build/install/default/lib/Preprocessor/Preprocessor__EvalOpt.cmt" - "_build/install/default/lib/Preprocessor/Preprocessor__EvalOpt.cmx" - "_build/install/default/lib/Preprocessor/Preprocessor__Preproc.cmi" - "_build/install/default/lib/Preprocessor/Preprocessor__Preproc.cmt" - "_build/install/default/lib/Preprocessor/Preprocessor__Preproc.cmx" - "_build/install/default/lib/Preprocessor/Preprocessor__E_AST.cmi" - "_build/install/default/lib/Preprocessor/Preprocessor__E_AST.cmt" - "_build/install/default/lib/Preprocessor/Preprocessor__E_AST.cmx" -] -doc: [ - "_build/install/default/doc/Preprocessor/LICENSE" - "_build/install/default/doc/Preprocessor/README.md" -] diff --git a/vendors/Preprocessor/dune b/vendors/Preprocessor/dune index a8636f4e4..dc61c5cee 100644 --- a/vendors/Preprocessor/dune +++ b/vendors/Preprocessor/dune @@ -26,7 +26,7 @@ (executable (name PreprocMain) (modules PreprocMain) - (libraries Preproc) + (libraries Preprocessor) (preprocess (pps bisect_ppx --conditional)))