Commit 280903ec authored by POGODALLA Sylvain's avatar POGODALLA Sylvain

Transition to menhir for acgc seems to work. Starting the transition of acg

parent b412c005
......@@ -39,11 +39,11 @@ sig
| Signature of Signature1.t
| Lexicon of Lexicon.t
val empty : t
val insert : ?override:bool -> entry -> to_be_dumped:bool -> t -> t
val insert : ?overwrite:bool -> entry -> to_be_dumped:bool -> t -> t
val get_signature : string -> t -> Signature1.t
val get_lexicon : string -> t -> Lexicon.t
val get : string -> t -> entry
val append : ?override:bool -> t -> t -> t
val append : ?overwrite:bool -> t -> t -> t
val iter : (entry -> unit) -> t -> unit
val fold : (entry -> 'a -> 'a) -> 'a -> t -> 'a
val sig_number : t -> int
......@@ -118,7 +118,7 @@ struct
else
()
let append ?(override=false) e1 e2 =
let append ?(overwrite=false) e1 e2 =
let () = check_version e1 in
let () = check_version e2 in
let erased_sig = ref 0 in
......@@ -126,7 +126,7 @@ struct
let new_map =
Env.merge
(fun k v1 v2 ->
match v1,v2,override with
match v1,v2,overwrite with
| None,None,_ -> None
| None,Some v,_ -> Some v
| Some v,None,_ -> Some v
......@@ -169,11 +169,11 @@ struct
(Lexicon l1)
(Dep.add_dependency (Lexicon lex) (Lexicon l2) m)
let insert ?(override=false) d ~to_be_dumped:dump e =
let insert ?(overwrite=false) d ~to_be_dumped:dump e =
match d with
| Signature s ->
let name,(p1,p2) = Sg.name s in
if (not (Env.mem name e.map))||override
if (not (Env.mem name e.map))||overwrite
then
{e with
map=Env.add name (d,dump) e.map ;
......@@ -182,7 +182,7 @@ struct
raise (Error.Error (Error.Env_error (Error.Duplicated_signature name,(p1,p2))))
| Lexicon l ->
let name,(p1,p2) = Lex.name l in
if not (Env.mem name e.map)||override
if not (Env.mem name e.map)||overwrite
then
{e with
map=Env.add name (d,dump) e.map ;
......@@ -250,6 +250,7 @@ struct
None
let write filename env =
let () = Logs.debug (fun m -> m "The environment currently has %d signature(s) and %d lexicon(s)." (sig_number env) (lex_number env)) in
let new_env =
Env.fold
(fun k (d,dump) acc ->
......
......@@ -57,8 +57,8 @@ sig
returns the resulting environmnent. If [d] is set to true, then
[c] is dumped in [e] by the
{!val:Environment.Environment_sig.write} function. The default
value for the [override] optional parameter is [false].*)
val insert : ?override:bool -> entry -> to_be_dumped:bool -> t -> t
value for the [overwrite] optional parameter is [false].*)
val insert : ?overwrite:bool -> entry -> to_be_dumped:bool -> t -> t
(** [get_signature name e] returns the signature of name [name] in
the environment [e]. Raise
......@@ -79,10 +79,10 @@ sig
(** [append e1 e2] merges the two environment [e1] and [e2]. If an
entry appears in both environment then the one of [e2] is kept
if the [override] parameter is set to [true] (default is
if the [overwrite] parameter is set to [true] (default is
[false]). If set to [false], if an entry appears in both
environment, an error is emitted. *)
val append : ?override:bool -> t -> t -> t
val append : ?overwrite:bool -> t -> t -> t
(** [iter f e] applies f to every data contained in the environment
*)
......
......@@ -58,7 +58,7 @@ sig
val expand_term : Lambda.term -> t -> Lambda.term
val add_warnings : Error.warning list -> t -> t
val get_warnings : t -> Error.warning list
(* val get_warnings : t -> Error.warning list *)
val to_string : t -> string
(* val term_to_string : term -> t -> string *)
(* val raw_to_string : term -> string*)
......
......@@ -139,7 +139,7 @@ sig
val add_warnings : Error.warning list -> t -> t
(** [get_warnings sg] returns the warnigs emitted while parsing [sg]. *)
val get_warnings : t -> Error.warning list
(* val get_warnings : t -> Error.warning list *)
(** [to_string sg] returns a string describing the signature
[sg]. Should be parsable *)
......
* TODO Add an optional ";" before the "end" keyword
; -*-org-*-
* DONE Add an optional ";" before the "end" keyword
* TODO Add precedence values and management in the signature
* TODO Add (+) notation style to prevent the infix use of +
* TODO Add syntactic extensions to handle associativity and precedence of infix operators
* TODO Add error (and warning) messages management to the Error module, and make a difference between "real" parsing errors and errors resulting from evaluating the parsing against some environment. The latter can be output all together (may be some limit to be set)
* TODO Move from dypgen to menhir in scripts
* TODO change README and INSTALL files:
+ [ ] to indicate new dependencies (menhir, logs...)
+ [ ] to document syntax extensions for infix operators, precedence of the latter over application. Highest precedence for prefix operators
......@@ -85,6 +85,7 @@ let parse filename dirs status =
match status with
| Failure -> Failure
| Success (name,env) ->
let () = Logs.debug (fun m -> m "The environment currently has %d signature(s) and %d lexicon(s)." (Actual_env.sig_number env) (Actual_env.lex_number env)) in
let file_type =
match Filename.check_suffix filename ".acg" with
| true -> Source
......@@ -94,7 +95,7 @@ let parse filename dirs status =
| false -> Neither) in
match file_type with
| Neither ->
let () = Printf.fprintf stderr "File name's suffixes should be \".acg\" or \".acgo\". The name \"%s\" has not this suffix.\n" filename in
let () = Logs.err (fun m -> m "File name's suffixes should be \".acg\" or \".acgo\". The name \"%s\" has not this suffix.\n" filename) in
Failure
| Source ->
let basename=Filename.basename filename in
......@@ -172,12 +173,13 @@ let output_env ?output_file name env =
| None -> name
| Some f -> f in
let () = Actual_env.write actual_output_file env in
Printf.printf "Output written on: \"%s\"\n%!" actual_output_file
Logs.app (fun m -> m "Output written on: \"%s\"\n%!" actual_output_file)
let main () =
let () = resize_terminal () in
let () = Log.set_level Logs.Warning in
let () = Log.set_level ~app:"acgc" Logs.Warning in
(* let () = Log.set_level ~app:"acgc" Logs.Debug in *)
let anon_fun file =
return_status := parse file !dirs !return_status in
let () = Arg.parse options anon_fun usg_msg in
......@@ -189,6 +191,7 @@ let main () =
let () = Printf.fprintf stderr "No ouput file is produced\nPlease specify an output file.\n%!"
in 0
| Some n ->
let () = Logs.debug (fun m -> m "The environment currently has %d signature(s) and %d lexicon(s)." (Actual_env.sig_number env) (Actual_env.lex_number env)) in
let () = output_env ?output_file:!output_name n env in
let () = term_parsing !interactive env in
0
......
......@@ -133,7 +133,7 @@ let string = (letter|digit|'_')*'\''*
| [] -> raise (Error.Error (Error.Lexer_error (Error.Unstarted_comment,loc lexbuf)))}
| "(*" {comment ((loc lexbuf)::depth) lexbuf}
| eof {raise (Error.Error (Error.Lexer_error (Error.Unclosed_comment, List.hd depth)))}
| newline {comment depth lexbuf}
| newline {let () = Error.update_loc lexbuf None in comment depth lexbuf}
| _ {comment depth lexbuf}
** Conflict (shift/reduce) in state 11.
** Token involved: IDENT
** This state is reached from heterogenous_term_and_type after reading:
IDENT
** The derivations that appear below have the following common factor:
** (The question mark symbol (?) represents the spot where the derivations begin to differ.)
heterogenous_term_and_type
term COLON type_expression EOI
not_atomic_term
(?)
** In state 11, looking ahead at IDENT, reducing production
** atomic_type_or_term -> IDENT
** is permitted because of the following sub-derivation:
term0 nonempty_list(term0) // lookahead token appears because nonempty_list(term0) can begin with IDENT
atomic_type_or_term // lookahead token is inherited
IDENT .
** In state 11, looking ahead at IDENT, shifting is permitted
** because of the following sub-derivation:
IDENT nonempty_list(IDENT) DOT term
. IDENT
This diff is collapsed.
......@@ -5,13 +5,13 @@
(menhir
; (flags (--explain --table --compile-errors /home/pogodall/work/dev/ACGtk/src/grammars/term_parser.messages))
(flags (--explain --table --trace))
(flags (--explain --table))
(modules term_parser))
(menhir
; (flags (--explain --table --compile-errors /home/pogodall/work/dev/ACGtk/src/grammars/data_parser.messages))
(merge_into data_parser)
(flags (--explain --table --trace))
(flags (--explain --table))
(modules file_parser sig_parser lex_parser type_parser term2_parser))
......@@ -26,7 +26,7 @@
(:parsers file_parser.mly lex_parser.mly sig_parser.mly term2_parser.mly type_parser.mly)
)
(action
(with-stdout-to messages.ml (run %{bin:menhir} --base data_parser --explain --table --trace --compile-errors %{message_file} %{parsers})))
(with-stdout-to messages.ml (run %{bin:menhir} --base data_parser --explain --table --compile-errors %{message_file} %{parsers})))
)
;; Rule to generate the automatic message file
......@@ -34,14 +34,14 @@
(targets data_parser.messages.automatic)
(deps (:parsers file_parser.mly lex_parser.mly sig_parser.mly term2_parser.mly type_parser.mly))
(action
(with-stdout-to data_parser.messages.automatic (run %{bin:menhir} --base data_parser --explain --table --trace --list-errors %{parsers})))
(with-stdout-to data_parser.messages.automatic (run %{bin:menhir} --base data_parser --explain --table --list-errors %{parsers})))
)
;; Rule to generate the message file
(rule
(targets data_parser.messages.new)
(deps (:parsers file_parser.mly lex_parser.mly sig_parser.mly term2_parser.mly type_parser.mly))
(action (with-stdout-to data_parser.messages.new (run %{bin:menhir} --base data_parser --explain --table --trace --update-errors data_parser.messages %{parsers}))
(action (with-stdout-to data_parser.messages.new (run %{bin:menhir} --base data_parser --explain --table --update-errors data_parser.messages %{parsers}))
)
)
......@@ -57,7 +57,7 @@
data_parser.messages
(:parsers file_parser.mly lex_parser.mly sig_parser.mly term2_parser.mly type_parser.mly)
)
(action (run %{bin:menhir} --base data_parser --explain --table --trace --compare-errors data_parser.messages.automatic --compare-errors data_parser.messages %{parsers}))
(action (run %{bin:menhir} --base data_parser --explain --table --compare-errors data_parser.messages.automatic --compare-errors data_parser.messages %{parsers}))
)
;; This stanza declares the Grammar library
......
......@@ -90,22 +90,22 @@
(*%right COMPOSE*)
%start <AcgData.Environment.Environment.t -> AcgData.Environment.Environment.t> main
%start <?overwrite:bool -> AcgData.Environment.Environment.t -> AcgData.Environment.Environment.t> main
%%
main:
| dec=sig_or_lex+ EOI { fun e -> List.fold_left (fun acc d -> d acc) e dec
| dec=sig_or_lex+ EOI { fun ?(overwrite=false) e -> List.fold_left (fun acc d -> d ~overwrite acc) e dec
}
sig_or_lex:
| s=signature { fun e -> s e }
| l=lexicon { fun e -> l e }
| s=signature { fun ~overwrite e -> s ~overwrite e }
| l=lexicon { fun ~overwrite e -> l ~overwrite e }
signature :
| SIG_OPEN id=IDENT EQUAL entries = signature_end_of_dec
| SIG_OPEN id=IDENT EQUAL entries = end_of_dec (sig_entry)
{
fun e ->
fun ~overwrite e ->
let s,loc = id in
if is_signature s e then
raise (Error.(Error (Env_error (Duplicated_signature s,loc))))
......@@ -115,10 +115,10 @@ sig_or_lex:
(fun acc entry -> entry acc e)
(Environment.Signature1.empty id)
entries in
Environment.(insert (Signature new_sig) false e)
Environment.(insert ~overwrite (Signature new_sig) ~to_be_dumped:true e)
}
(*
signature_end_of_dec :
| entry = sig_entry SEMICOLON? END_OF_DEC
{
......@@ -127,7 +127,7 @@ sig_or_lex:
| entry = sig_entry SEMICOLON entries = signature_end_of_dec
{ entry :: entries }
*)
(*
| SIG_OPEN id=IDENT EQUAL entries=separated_list(SEMICOLON,sig_entry) END_OF_DEC
{
......@@ -147,17 +147,17 @@ sig_or_lex:
lexicon :
| LEX_OPEN lex=lex_declaration
{fun e -> lex ~non_linear:false e }
{fun ~overwrite e -> lex ~overwrite ~non_linear:false e }
| NL_LEX_OPEN lex=lex_declaration
{fun e -> lex ~non_linear:true e }
| LEX_OPEN lex=IDENT EQUAL exp=lexicon_exp {fun e ->
{fun ~overwrite e -> lex ~overwrite ~non_linear:true e }
| LEX_OPEN lex=IDENT EQUAL exp=lexicon_exp {fun ~overwrite e ->
let new_lex = exp (Some lex) e in
Environment.(insert (Lexicon new_lex) false e)}
Environment.(insert ~overwrite (Lexicon new_lex) ~to_be_dumped:true e)}
%inline lex_declaration :
| lex=IDENT LPAREN abs=IDENT RPAREN COLON obj=IDENT EQUAL END_OF_DEC
(*| lex=IDENT LPAREN abs=IDENT RPAREN COLON obj=IDENT EQUAL END_OF_DEC
{
fun ~non_linear e ->
let lex_name,lex_loc = lex in
......@@ -168,10 +168,10 @@ lexicon :
let lex' = Environment.Lexicon.empty lex ~abs:abs' ~obj:obj' ~non_linear in
Environment.(insert (Lexicon lex') false e)
}
*)
| lex=IDENT LPAREN abs=IDENT RPAREN COLON obj=IDENT EQUAL entries=separated_nonempty_list(SEMICOLON,lex_entry) END_OF_DEC
{fun ~non_linear e ->
| lex=IDENT LPAREN abs=IDENT RPAREN COLON obj=IDENT EQUAL entries = end_of_dec(lex_entry)
{fun ~overwrite ~non_linear e ->
let lex_name,lex_loc = lex in
let abs',obj'= get_sig abs e,get_sig obj e in
if is_lexicon lex_name e then
......@@ -181,11 +181,15 @@ lexicon :
(fun acc entry -> entry acc e)
(Environment.Lexicon.empty lex ~abs:abs' ~obj:obj' ~non_linear)
entries in
(* let lex' = entry lex' e in *)
let () = Environment.Lexicon.check lex' in
Environment.(insert (Lexicon lex') false e)
Environment.(insert ~overwrite (Lexicon lex') ~to_be_dumped:true e)
}
end_of_dec(entry_type):
| entry = entry_type SEMICOLON? END_OF_DEC { [entry] }
| entry = entry_type SEMICOLON entries = end_of_dec(entry_type) { entry :: entries }
lexicon_exp0 :
| lex = IDENT { fun _ e -> get_lex lex e }
| LPAREN lex = lexicon_exp RPAREN { lex }
......
......@@ -12,127 +12,127 @@ let message =
"A term or a colon \":\" are expected.\n"
| 1 ->
"A term is expected.\n"
| 35 | 39 | 17 | 18 | 21 | 22 ->
| 32 | 37 | 17 | 18 | 21 | 22 ->
"A term or a right parenthesis \")\" are expected.\n"
| 3 ->
"An identifier (the name of a bound variable) or a dot \".\" are expected.\n"
| 7 | 2 ->
| 5 | 2 ->
"An identifier (the name of a bound variable) is expected.\n"
| 42 | 10 | 19 | 40 ->
| 40 | 7 | 19 | 38 ->
"A term or a colon \":\" are expected.\n"
| 9 | 6 ->
| 4 ->
"A term is expected.\n"
| 62 ->
| 60 ->
"An identifier (i.e., a type or a term) or a symbol are expected.\n"
| 74 ->
| 72 ->
"A comma \",\" or an interpretation symbol \":=\" are expected.\n"
| 75 ->
| 73 ->
"An identifier (i.e., a type or a term) or a symbol are expected.\n"
| 67 | 66 | 44 | 43 ->
| 65 | 64 | 42 | 41 ->
"A term or a type are expected.\n"
| 58 ->
| 56 ->
"An arrow (\"->\" or \"=>\"), a right parenthesis, a term, or a semi-colon are expected.\n"
| 45 ->
| 43 ->
"An arrow (\"->\" or \"=>\"), a right parenthesis, or a semi-colon are expected.\n"
| 47 ->
| 45 ->
"An arrow (\"->\" or \"=>\"), or a semi-colon are expected.\n"
| 72 | 59 ->
| 70 | 57 ->
"An end of input is expected (no more keyword or semi-colon or colon).\n"
| 70 ->
| 68 ->
"An arrow (\"->\" or \"=>), a term, or a semi-colon are expected.\n"
| 54 | 52 | 56 | 48 ->
| 52 | 50 | 54 | 46 ->
"A type expression is expected.\n"
| 79 ->
| 77 ->
"An equality symbol \"=\" is expected.\n"
| 127 | 80 ->
| 124 | 78 ->
"A signature entry (type declaration, type definition, term declaration, or term definition) is expected.\n"
| 77 ->
| 75 ->
"A declaration of a signature (keyword \"signature\") or of a lexicon (keyword \"lexicon\" or \"nl_lexicon\") is expected.\n"
| 135 ->
| 133 ->
"An identifier (the name of a new lexicon) is expected.\n"
| 136 ->
| 134 ->
"A left parenthesis \"(\" is expected.\n"
| 138 ->
| 136 ->
"A right parenthesis \")\" is expected.\n"
| 139 ->
| 137 ->
"A colon \":\" is expected.\n"
| 140 ->
| 138 ->
"An identifier (the name of a signature) is expected.\n"
| 141 ->
| 139 ->
"An equality symbol \"=\" is expected.\n"
| 146 ->
| 141 ->
"A semi-colon \";\" or the \"end\" keyword are expected.\n"
| 149 ->
| 147 ->
"An identifier (the name of a new lexicon) is expected\n"
| 150 ->
| 148 ->
"A left parenthesis \"(\" is expected.\n"
| 151 ->
| 149 ->
"An identifier (the name of a signature) is expected.\n"
| 152 ->
| 150 ->
"A right parenthesis \")\" is expected.\n"
| 153 ->
| 151 ->
"A expression in the form of \": <identifier> =\" where the identifier is the name of a signature is expected.\n"
| 154 | 137 | 78 ->
| 152 | 135 | 76 ->
"An identifier (the name of a signature) is expected.\n"
| 155 ->
| 153 ->
"An equality symbold \"=\" is expected.\n"
| 156 | 147 | 142 ->
| 154 | 142 | 140 ->
"A lexicon entry of the form \"<term> := <term>;\" or \"<type> := <type>\" is expected.\n"
| 161 | 160 ->
| 157 | 156 ->
"An expression representing the composition of lexicons is expected.\n"
| 166 ->
| 162 ->
"The composition operator \"<<\" or a right parenthesis \")\" is expected.\n"
| 163 | 170 ->
| 159 | 166 ->
"The composition operator \"<<\" is expected.\n"
| 164 ->
| 160 ->
"An identifier (the name of a lexicon), or an expression representing the composition of lexicons is expected.\n"
| 176 ->
| 172 ->
"An identifier or a keyword (\"infix\", \"prefix, or \"binder\") is expected.\n"
| 89 | 81 ->
| 87 | 79 ->
"A symbol is expected.\n"
| 90 | 82 ->
| 88 | 80 ->
"A typing judgmenet in the form of \": <type>;\" or a defintion in the form of \"= <term>: <type>;\" is expected.\n"
| 91 | 83 ->
| 89 | 81 ->
"A typing judgment in the form \"term : <type>;\" is expected.\n"
| 92 | 84 ->
| 90 | 82 ->
"A typing judgment in the form \": <type>;\" is expected.\n"
| 95 | 93 | 87 | 85 ->
| 93 | 91 | 85 | 83 ->
"A type is expected after the colon \":\".\n"
| 97 ->
| 95 ->
"A comma \",\" or a colon \":\" are expected in a type or term declaration. An equality symbol \"=\" is expected in a type or term definition.\n"
| 98 ->
| 96 ->
"A definition in the form of \"<term> : <type>;\" or a type definition of the form \"<type> : type;\" is expected after a term or a type defintion, resp.\n"
| 102 ->
| 100 ->
"A typing judgement in the form of \": <type>\" is expected in a term definition.\n"
| 103 ->
| 101 ->
"A type is expected in a term definition.\n"
| 105 ->
| 103 ->
"A typing judgement in the form of \": <type>;\" or a type definition with a colon and the \"type\" keyword in the form of \": type;\" is expectedin a term or a type definition.\n"
| 118 ->
| 116 ->
"The \"type\" keyword or a typing judgement in the form of \": <type>;\" is expected after the definition of a type or a term, resp.\n"
| 99 ->
| 97 ->
"In a type definition, a colon \":\" is expeced before the keyword \"type\".\n"
| 100 ->
| 98 ->
"In a type definition, the keyword \"type\" is expected after the colon \":\".\n"
| 108 | 107 ->
| 106 | 105 ->
"After a term or type declaration of the form \"<ident1>, <ident2>\", a type declaration of the form \": type;\" (where type is a keyword) or a typing judgment of the form \": <type>;\" is expected.\n"
| 130 ->
| 126 ->
"After a term declaration of the form \"<term>: \", a type expression and a semicolon \"<type> ;\" are expected.\n"
| 178 ->
| 174 ->
"After a term declaration of the form \"<term>: <type>\", a semicolon \";\" is expected.\n"
| 110 ->
| 108 ->
"An identidier (the name of the binder) is expected after the keyword \"binder\".\n"
| 111 ->
| 109 ->
"A typing judgement in the form of \": <type>\" or a definition in the form of \"= <term> : <type>\" is expected after the declaration of a binder.\n"
| 112 ->
| 110 ->
"A term is expected as right hand side of a term definition.\n"
| 113 ->
| 111 ->
"A typing judgment in the form of \": <type>\" is expected after defining a binder.\n"
| 180 | 11 | 32 ->
| 176 | 8 ->
"A typing judgment in the form of \"<term> : <type>\" is expected.\n"
| 182 ->
| 178 ->
"A typing judgement in the form of \": <type>\" is expected after a term.\n"
| 184 | 183 | 116 | 114 | 126 ->
| 180 | 179 | 114 | 112 | 123 ->
"A type expression is expected after \":\".\n"
| _ ->
raise Not_found
......@@ -40,12 +40,11 @@ module I = Data_parser.MenhirInterpreter
replaced with the following code, which exploits the functions
[lexer_lexbuf_to_supplier] and [loop_handle] offered by Menhir. *)
let succeed (data : Environment.t -> Environment.t) =
(* The parser has succeeded and produced a semantic value. Print it. *)
let () = Printf.printf "Success!\n%!" in
let succeed (data : (?overwrite:bool -> Environment.t -> Environment.t)) =
(* The parser has succeeded and produced a semantic value. *)
data
let fail lexbuf (c : (Environment.t -> Environment.t) I.checkpoint) =
let fail lexbuf (c : (?overwrite:bool -> Environment.t -> Environment.t) I.checkpoint) =
(* The parser has suspended itself because of a syntax error. Stop. *)
match c with
| I.HandlingError env ->
......@@ -71,25 +70,24 @@ let supplier lexbuf =
let supplier = core_supplier
let parse_data ?(override=false) ?(output=false) filename includes env =
let parse_data ?(overwrite=false) ?(output=false) filename includes env =
try
let in_ch =
let fullname = Utils.find_file filename includes in
open_in fullname in
let lexbuf = Lexing.from_channel in_ch in
let () = Printf.printf "Parsing \"%s\"...\n%!" filename in
let () = Logs.app (fun m -> m "Parsing \"%s\"..." filename) in
let starting_parse_time = Sys.time () in
let e = (I.loop_handle succeed (fail lexbuf) (supplier lexbuf) (Data_parser.Incremental.main lexbuf.lex_curr_p)) env in
let e = (I.loop_handle succeed (fail lexbuf) (supplier lexbuf) (Data_parser.Incremental.main lexbuf.lex_curr_p)) ~overwrite env in
let ending_parse_time = Sys.time () in
let () = Printf.printf "Done (required %.3f seconds).\n%!" (ending_parse_time -. starting_parse_time) in
let () = Logs.app (fun m -> m "Done (required %.3f seconds).\n%!" (ending_parse_time -. starting_parse_time)) in
let () = match output with
| false -> ()
| true ->
Environment.iter
(function
| Environment.Signature sg ->
let () = Printf.printf "%s\n%!" (Environment.Signature1.to_string sg) in
Printf.printf "%s\n%!" (Error.warnings_to_string filename (Environment.Signature1.get_warnings sg))
Printf.printf "%s\n%!" (Environment.Signature1.to_string sg)
| Environment.Lexicon lex ->
Printf.printf "%s\n%!" (Environment.Lexicon.to_string lex))
e in
......@@ -97,14 +95,14 @@ let parse_data ?(override=false) ?(output=false) filename includes env =
with
| Utils.No_file(f,msg) ->
let e = Error.System_error (Printf.sprintf "No such file \"%s\" in %s" f msg) in
let () = Printf.fprintf stderr "Error: %s\n%!" (Error.error_msg e filename) in
let () = Logs.err (fun m -> m "Error: %s\n%!" (Error.error_msg e filename)) in
None
| Sys_error s ->
let e = Error.System_error s in
let () = Printf.fprintf stderr "Error: %s\n%!" (Error.error_msg e filename) in
let () = Logs.err (fun m -> m "Error: %s\n%!" (Error.error_msg e filename)) in
None
| Error.Error e ->
let () = Printf.fprintf stderr "Error: %s\n%!" (Error.error_msg e filename) in
let () = Logs.err (fun m -> m "Error: %s\n%!" (Error.error_msg e filename)) in
None
let pp_error er t =
......@@ -117,7 +115,7 @@ let pp_error er t =
let end_start_index = (s' + (e'-s')) in
let t_end = String.sub t end_start_index ((String.length t) - end_start_index) in
let () = Printf.fprintf stderr "%s%s%s\n" t_init t_error t_end in
Printf.fprintf stderr "Error: %s\n%!" (Error.error_msg er "stdin")
Logs.err (fun m -> m "Error: %s\n%!" (Error.error_msg er "stdin"))
let parse_term ?(output=false) t sg =
let lexbuf = Lexing.from_string t in
......@@ -164,16 +162,16 @@ let parse_heterogenous_term ?(output=false) t lex =
let () = match output with
| true ->
let () =
Printf.printf
"%s : %s (as image of %s)\n%!"
(Environment.Signature1.term_to_string obj_term obj)
(Environment.Signature1.type_to_string obj_type obj)
(Environment.Signature1.type_to_string abs_type abs) in
Printf.printf
"%s : %s (as image of %s)\n%!"
(Environment.Signature1.term_to_string (Environment.Signature1.unfold obj_term obj) obj)
(Environment.Signature1.type_to_string obj_type obj)
(Environment.Signature1.type_to_string abs_type abs)
Logs.app (fun m -> m
"%s : %s (as image of %s)\n%!"
(Environment.Signature1.term_to_string obj_term obj)
(Environment.Signature1.type_to_string obj_type obj)
(Environment.Signature1.type_to_string abs_type abs)) in
Logs.app (fun m -> m
"%s : %s (as image of %s)\n%!"
(Environment.Signature1.term_to_string (Environment.Signature1.unfold obj_term obj) obj)
(Environment.Signature1.type_to_string obj_type obj)
(Environment.Signature1.type_to_string abs_type abs))
| false -> () in
Some (obj_term,abs_type)
with
......@@ -182,32 +180,26 @@ let parse_heterogenous_term ?(output=false) t lex =
None
| End_of_file -> None
let parse_sig_entry t sg =
let lexbuf = Lexing.from_string t in
try
Some (I.loop (supplier lexbuf) (Data_parser.Incremental.sig_entry_eoi lexbuf.lex_curr_p) sg )
with
| Error.Error er ->
let () = pp_error er t in
None
| End_of_file -> None
let parse_lex_entry t lex =
let lexbuf = Lexing.from_string t in
try
Some (I.loop (supplier lexbuf) (Data_parser.Incremental.lex_entry_eoi lexbuf.lex_curr_p) lex )
with
| Error.Error er ->
let () = pp_error er t in
None
| End_of_file -> None
let parse_sig_entry t sg e =
let lexbuf = Lexing.from_string t in
try
Some (I.loop (supplier lexbuf) (Data_parser.Incremental.sig_entry_eoi lexbuf.lex_curr_p) sg e)
with
| Error.Error er ->
let () = pp_error er t in
None
| End_of_file -> None
let parse_lex_entry t lex e =
let lexbuf = Lexing.from_string t in