Commit 5a51c80a authored by POGODALLA Sylvain's avatar POGODALLA Sylvain

This version now compiles with the menhir parser and the messages. Bug chasings starts...

parent 07cb17e6
......@@ -51,6 +51,7 @@ type lex_error =
| Bad_token
type parse_error =
| Syntax_error of string
| Duplicated_term of string
| Duplicated_type of string
| Binder_expected of string
......@@ -135,6 +136,7 @@ let lex_error_to_string = function
| Bad_token -> "Lexing error: no such token allowed"
let parse_error_to_string = function
| Syntax_error s -> Printf.sprintf "Syntax error: %s" s
| Duplicated_type ty -> Printf.sprintf "Syntax error: Type \"%s\" has already been defined" ty
| Duplicated_term te -> Printf.sprintf "Syntax error: Term \"%s\" has already been defined" te
| Binder_expected id -> Printf.sprintf "Syntax error: Unknown binder \"%s\"" id
......
......@@ -34,6 +34,7 @@ type lex_error =
(** The type for errors raised by the parser. Names should be explicit
*)
type parse_error =
| Syntax_error of string
| Duplicated_term of string
| Duplicated_type of string
| Binder_expected of string
......
......@@ -44,6 +44,8 @@ sig
val find_term : string -> t -> term * stype
val is_type : string -> t -> bool
val is_constant : string -> t -> bool*Abstract_syntax.syntactic_behavior option
val precedence : string -> t -> (float*Abstract_syntax.associativity) option
val new_precedence : t -> (float * t)
val type_to_string : stype -> t -> string
val term_to_string : term -> t -> string
val id_to_string : t -> int -> Abstract_syntax.syntactic_behavior*string
......
......@@ -85,6 +85,16 @@ sig
and [false,None] oterwise *)
val is_constant : string -> t -> bool * Abstract_syntax.syntactic_behavior option
(** [precedence id s] returns a [Some f] where [f] is float
indicating the precedence of the infix operator [id]. It returns
[None] if [id] is not an infix operator. *)
val precedence : string -> t -> (float * Abstract_syntax.associativity) option
(** [new_precedence s] returns a pair consisting of a new precedence
value, higher thant any other one in the signature [s], and the
new signature taking this new value into account. *)
val new_precedence : t -> (float * t)
(** [type_to_string ty sg] returns the string corresponding to a
type [ty] of type {!Logic.Lambda.Lambda.stype}) with respect to the
signature [sg] *)
......
......@@ -51,6 +51,7 @@ struct
types:entry Symbols.t;
ids:entry Id.t;
is_2nd_order:bool;
precedence:float;
extension_timestamp:float;
definition_timestamp:float}
......@@ -91,7 +92,15 @@ struct
let empty n =
let timestamp = Unix.time () in
{name=n;size=0;terms=Symbols.empty;types=Symbols.empty;ids=Id.empty;is_2nd_order=true;definition_timestamp=timestamp;extension_timestamp=timestamp}
{name=n;
size=0;
terms=Symbols.empty;
types=Symbols.empty;
ids=Id.empty;
is_2nd_order=true;
precedence = 0.;
definition_timestamp=timestamp;
extension_timestamp=timestamp}
let name {name=n} = n
......@@ -284,7 +293,18 @@ struct
| Term_definition (_,_,behavior,_,_) -> true,Some behavior
| _ -> false,None
| exception Symbols.Not_found -> false,None
let precedence s {terms=syms} =
match Symbols.find s syms with
| Term_declaration (_,_,Infix f,_) -> Some f
| Term_definition (_,_,Infix f,_,_) -> Some f
| _ -> None
| exception Symbols.Not_found -> None
let new_precedence sg =
let p = sg.precedence +. 1. in
p,{sg with precedence = p}
let add_warnings _ sg = sg
let get_warnings _ = []
......
* TODO Add an optional ";" before the "end" keyword
......@@ -21,15 +21,6 @@
open UtilsLib
open AcgData
open Entry
type lexing_of =
| Data of Entry.data
| Term of Entry.term
| Type of Entry.stype
let pr lexbuf = Printf.printf "%s\n%!" (Lexing.lexeme lexbuf)
let loc lexbuf = Lexing.lexeme_start_p lexbuf,Lexing.lexeme_end_p lexbuf
......@@ -49,35 +40,6 @@
raise (Error.Error (Error.Lexer_error (Error.Mismatch_parentheses,(p1,p2))))
let data = ref (Data (Entry.start_data ()))
let set_to_data () =
data := Data (Entry.start_data ())
let set_to_term () =
data := Term (Entry.start_term ())
let set_to_type () =
data := Type (Entry.start_type ())
let set_to_sig_entry () =
data := Data (Entry.start_sig_entry ())
let set_to_lex_entry () =
data := Data (Entry.start_lex_entry ())
let update_data v (p1,p2) =
try
match !data with
| Data d -> data := Data (Entry.data_transition d v)
| Term t -> data := Term (Entry.term_transition t v)
| Type t -> data := Type (Entry.type_transition t v)
with
| Entry.Expect l ->
let s = Utils.string_of_list " or " Entry.valuation_to_string l in
raise (Error.Error (Error.Lexer_error (Error.Expect s,(p1,p2))))
}
......@@ -96,76 +58,72 @@ let string = (letter|digit|'_')*'\''*
| newline {let () = Error.update_loc lexbuf None in lexer lexbuf}
| "(*" {comment [loc lexbuf] lexbuf}
| "*)" {raise (Error.Error (Error.Lexer_error (Error.Unstarted_comment,loc lexbuf)))}
| eof {let () = update_data Entry.EOI (loc lexbuf) in
| eof {
let () = check_brackets () in
Data_parser.EOI}
| ['='] {let () = update_data Entry.Equal (loc lexbuf) in
| ['='] {
let () = check_brackets () in
Data_parser.EQUAL(loc lexbuf)}
| "<<" {let () = update_data Entry.Compose (loc lexbuf) in
| "<<" {
let () = check_brackets () in
Data_parser.COMPOSE(loc lexbuf)}
| [';'] {let () = update_data Entry.Semi_colon (loc lexbuf) in
| [';'] {
let () = check_brackets () in
Data_parser.SEMICOLON(loc lexbuf)}
| [':'] {let () = update_data Entry.Colon (loc lexbuf) in
| [':'] {
let () = check_brackets () in
Data_parser.COLON(loc lexbuf)}
| [','] {let () = update_data Entry.Comma (loc lexbuf) in
| [','] {
let () = check_brackets () in
Data_parser.COMMA(loc lexbuf)}
| ['('] {let () = update_data (Entry.Type_or_term Entry.LPAR) (loc lexbuf) in
| ['('] {
let l = loc lexbuf in
let () = add_bracket l in
Data_parser.LPAREN l}
| [')'] {let () = update_data (Entry.Type_or_term Entry.RPAR) (loc lexbuf) in
| [')'] {
let brac_loc = loc lexbuf in
let () = remove_bracket brac_loc in
Data_parser.RPAREN brac_loc}
| ['.'] {let () = update_data (Entry.Type_or_term Entry.DOT) (loc lexbuf) in
| ['.'] {
Data_parser.DOT(loc lexbuf)}
| "signature" {let () = update_data Entry.Sig_kwd (loc lexbuf) in
| "signature" {
let () = check_brackets () in
Data_parser.SIG_OPEN(loc lexbuf)}
| "lexicon" {let () = update_data Entry.Lex_kwd (loc lexbuf) in
| "lexicon" {
let () = check_brackets () in
Data_parser.LEX_OPEN(loc lexbuf)}
| "nl_lexicon" {let () = update_data Entry.Lex_kwd (loc lexbuf) in
| "nl_lexicon" {
let () = check_brackets () in
Data_parser.NL_LEX_OPEN(loc lexbuf)}
| "end" {let () = update_data Entry.End_kwd (loc lexbuf) in
| "end" {
let () = check_brackets () in
Data_parser.END_OF_DEC(loc lexbuf)}
| "type" {let () = update_data Entry.Type_kwd (loc lexbuf) in
| "type" {
let () = check_brackets () in
Data_parser.TYPE(loc lexbuf)}
| "prefix" {let () = update_data Entry.Prefix_kwd (loc lexbuf) in
| "prefix" {
let () = check_brackets () in
Data_parser.PREFIX(loc lexbuf)}
| "infix" {let () = update_data Entry.Infix_kwd (loc lexbuf) in
| "infix" {
let () = check_brackets () in
Data_parser.INFIX(loc lexbuf)}
| "binder" {let () = update_data Entry.Binder_kwd (loc lexbuf) in
| "binder" {
let () = check_brackets () in
Data_parser.BINDER(loc lexbuf)}
| "lambda" {let () = update_data (Entry.Type_or_term Entry.LAMBDA) (loc lexbuf) in
| "lambda" {
Data_parser.LAMBDA0(loc lexbuf)}
| "Lambda" {let () = update_data (Entry.Type_or_term Entry.LAMBDA) (loc lexbuf) in
| "Lambda" {
Data_parser.LAMBDA(loc lexbuf)}
| "->" {let () = update_data (Entry.Type_or_term Entry.ARROW) (loc lexbuf) in
| "->" {
Data_parser.LIN_ARROW(loc lexbuf)}
| "=>" {let () = update_data (Entry.Type_or_term Entry.ARROW) (loc lexbuf) in
| "=>" {
Data_parser.ARROW(loc lexbuf)}
| ":=" {let () = update_data Entry.Colon_equal (loc lexbuf) in
| ":=" {
Data_parser.COLON_EQUAL(loc lexbuf)}
| letter string {
let id = Lexing.lexeme lexbuf in
let () = match id with
| "extend" -> update_data Entry.Ext_kwd (loc lexbuf)
| "with" -> update_data Entry.With_kwd (loc lexbuf)
| _ -> update_data Entry.Id (loc lexbuf) in
Data_parser.IDENT (id,loc lexbuf)}
| symbol {let () = update_data Entry.Sym (loc lexbuf) in
| symbol {
Data_parser.SYMBOL (Lexing.lexeme lexbuf,loc lexbuf)}
| _ as input_char {let () = Printf.fprintf stderr "%c" input_char in raise (Error.Error (Error.Lexer_error (Error.Bad_token,loc lexbuf)))}
and comment depth = parse
......@@ -175,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 {let () = Error.update_loc lexbuf None in comment depth lexbuf}
| newline {comment depth lexbuf}
| _ {comment depth lexbuf}
This diff is collapsed.
......@@ -14,7 +14,7 @@
(modules term_parser))
(menhir
; (flags (--explain --table --compile-errors /home/pogodall/work/dev/ACGtk/src/grammars/term_parser.messages))
; (flags (--explain --table --compile-errors /home/pogodall/work/dev/ACGtk/src/grammars/data_parser.messages))
(merge_into data_parser)
(flags (--explain --table))
(modules file_parser sig_parser lex_parser type_parser term2_parser))
......
......@@ -106,15 +106,10 @@
else
let new_sig =
List.fold_left
(fun acc entry ->
try
Environnement.Signature1.add_entry (entry acc e) acc
with
| Environment.Signature1.Duplicate_type_definition ->
emit_parse_error (Error.Duplicated_type s) loc)
Environnement.Signature1.empty
(fun acc entry -> entry acc e)
(Environment.Signature1.empty id)
entries in
Environnement.(insert (Signature new_sig) false e)
Environment.(insert (Signature new_sig) false e)
}
......
......@@ -57,7 +57,7 @@
{
fun lex e ->
let abs,obj = Environment.Lexicon.get_sig lex in
let term,loc,ws = t obj e in
let term,loc = t obj in
List.fold_left
(fun acc (id,l) ->
match Environment.Signature1.is_constant id abs,Environment.Signature1.is_type id abs with
......
(* This file was auto-generated based on "data_parser.messages". *)
(* Please note that the function [message] can raise [Not_found]. *)
let message =
fun s ->
match s with
| 0 ->
"A term is expected.\n"
| 16 | 14 ->
"A term or a colon \":\" are expected.\n"
| 2 ->
"A term is expected.\n"
| 27 | 25 ->
"A term or a right parenthesis \")\" are expected.\n"
| 4 ->
"An identifier (the name of a bound variable) or a dot \".\" are expected.\n"
| 8 | 3 ->
"An identifier (the name of a bound variable) is expected.\n"
| 22 | 29 | 11 ->
"A term or a colon \":\" are expected.\n"
| 13 | 10 | 7 ->
"A term is expected.\n"
| 49 ->
"An identifier (i.e., a type or a term) or a symbol are expected.\n"
| 62 ->
"A comma \",\" or an interpretation symbol \":=\" are expected.\n"
| 63 ->
"An identifier (i.e., a type or a term) or a symbol are expected.\n"
| 54 | 53 | 31 | 30 ->
"A term or a type are expected.\n"
| 55 | 45 ->
"An arrow (\"->\" or \"=>\"), a right parenthesis, a term, or a semi-colon are expected.\n"
| 32 ->
"An arrow (\"->\" or \"=>\"), a right parenthesis, or a semi-colon are expected.\n"
| 34 ->
"An arrow (\"->\" or \"=>\"), or a semi-colon are expected.\n"
| 60 | 46 ->
"An end of input is expected (no more keyword or semi-colon or colon).\n"
| 58 ->
"An arrow (\"->\" or \"=>), a term, or a semi-colon are expected.\n"
| 41 | 39 | 43 | 35 ->
"A type expression is expected.\n"
| 67 ->
"An equality symbol \"=\" is expected.\n"
| 114 | 68 ->
"A signature entry (type declaration, type definition, term declaration, or term definition) is expected.\n"
| 156 | 65 ->
"A declaration of a signature (keyword \"signature\") or of a lexicon (keyword \"lexicon\" or \"nl_lexicon\") is expected.\n"
| 123 ->
"An identifier (the name of a new lexicon) is expected.\n"
| 124 ->
"A left parenthesis \"(\" is expected.\n"
| 126 ->
"A right parenthesis \")\" is expected.\n"
| 127 ->
"A colon \":\" is expected.\n"
| 128 ->
"An identifier (the name of a signature) is expected.\n"
| 129 ->
"An equality symbol \"=\" is expected.\n"
| 134 ->
"A semi-colon \";\" or the \"end\" keyword are expected.\n"
| 137 ->
"An identifier (the name of a new lexicon) is expected\n"
| 138 ->
"A left parenthesis \"(\" is expected.\n"
| 139 ->
"An identifier (the name of a signature) is expected.\n"
| 140 ->
"A right parenthesis \")\" is expected.\n"
| 141 ->
"A expression in the form of \": <identifier> =\" where the identifier is the name of a signature is expected.\n"
| 142 | 125 | 66 ->
"An identifier (the name of a signature) is expected.\n"
| 143 ->
"An equality symbold \"=\" is expected.\n"
| 144 | 135 | 130 ->
"A lexicon entry of the form \"<term> := <term>;\" or \"<type> := <type>\" is expected.\n"
| 148 | 147 ->
"An expression representing the composition of lexicons is expected.\n"
| 153 ->
"The composition operator \"<<\" or a right parenthesis \")\" is expected.\n"
| 159 | 150 ->
"The composition operator \"<<\" is expected.\n"
| 151 ->
"An identifier (the name of a lexicon), or an expression representing the composition of lexicons is expected.\n"
| 161 ->
"An identifier or a keyword (\"infix\", \"prefix, or \"binder\") is expected.\n"
| 77 | 69 ->
"A symbol is expected.\n"
| 78 | 70 ->
"A typing judgmenet in the form of \": <type>;\" or a defintion in the form of \"= <term>: <type>;\" is expected.\n"
| 79 | 71 ->
"A typing judgment in the form \"term : <type>;\" is expected.\n"
| 80 | 72 ->
"A typing judgment in the form \": <type>;\" is expected.\n"
| 83 | 81 | 75 | 73 ->
"A type is expected after the colon \":\".\n"
| 85 ->
"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"
| 86 ->
"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"
| 90 ->
"A typing judgement in the form of \": <type>\" is expected in a term definition.\n"
| 91 ->
"A type is expected in a term definition.\n"
| 93 ->
"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"
| 106 ->
"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"
| 87 ->
"In a type definition, a colon \":\" is expeced before the keyword \"type\".\n"
| 88 ->
"In a type definition, the keyword \"type\" is expected after the colon \":\".\n"
| 96 | 95 ->
"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"
| 117 ->
"After a term declaration of the form \"<term>: \", a type expression and a semicolon \"<type> ;\" are expected.\n"
| 163 ->
"After a term declaration of the form \"<term>: <type>\", a semicolon \";\" is expected.\n"
| 98 ->
"An identidier (the name of the binder) is expected after the keyword \"binder\".\n"
| 99 ->
"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"
| 100 ->
"A term is expected as right hand side of a term definition.\n"
| 101 ->
"A typing judgment in the form of \": <type>\" is expected after defining a binder.\n"
| 165 ->
"A typing judgment in the form of \"<term> : <type>\" is expected.\n"
| 167 ->
"A typing judgement in the form of \": <type>\" is expected after a term.\n"
| 169 | 168 | 104 | 102 | 113 ->
"A type expression is expected after \":\".\n"
| _ ->
raise Not_found
......@@ -2,6 +2,7 @@ open UtilsLib
open AcgData
open Environment
(* A short name for the incremental parser API. *)
module I = Data_parser.MenhirInterpreter
......@@ -14,15 +15,20 @@ module I = Data_parser.MenhirInterpreter
let succeed (data : Environment.t -> Environment.t) =
(* The parser has succeeded and produced a semantic value. Print it. *)
let () = Printf.printf "Success!\n%!" in data
let () = Printf.printf "Success!\n%!" in
data
let fail lexbuf (c : (Environment.t -> Environment.t) I.checkpoint) =
(* The parser has suspended itself because of a syntax error. Stop. *)
match c with
| I.HandlingError env ->
let msg = Error.compute_comment_for_position (Lexing.lexeme_start_p lexbuf) (Lexing.lexeme_end_p lexbuf) in
Printf.fprintf stderr "%s\nError:" msg (*message current_state_num*)
| _ -> failwith "Should not happen. Alway fails with a HandlingError"
let loc = Lexing.lexeme_start_p lexbuf,Lexing.lexeme_end_p lexbuf in
let current_state_num = I.current_state_number env in
raise Error.(Error (Parse_error (Syntax_error ((Messages.message current_state_num)),loc)))
| _ -> failwith "Should not happen. Always fails with a HandlingError"
| exception Not_found ->
let loc = Lexing.lexeme_start_p lexbuf,Lexing.lexeme_end_p lexbuf in
raise Error.(Error (Parse_error (Syntax_error (""),loc)))
let parse_data ?(override=false) ?(output=false) filename includes env =
......@@ -34,7 +40,7 @@ let parse_data ?(override=false) ?(output=false) filename includes env =
let () = Printf.printf "Parsing \"%s\"...\n%!" filename in
let supplier = I.lexer_lexbuf_to_supplier Data_lexer.lexer lexbuf in
let starting_parse_time = Sys.time () in
let e = I.loop supplier (Data_parser.Incremental.main lexbuf.lex_curr_p) env in
let e = (I.loop_handle succeed (fail lexbuf) supplier (Data_parser.Incremental.main lexbuf.lex_curr_p)) 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 () = match output with
......
......@@ -49,7 +49,7 @@ sig_entry_eoi :
let (id_name,id_loc),(type_expr,type_expr_loc) = definition in
if Environment.Signature1.is_type type_expr sg then
try
Environment.Signature1.add_entry (Abstract_syntax.Type_def (id_name,id_loc,type_expr,Abstract_syntax.K [])) s
Environment.Signature1.add_entry (Abstract_syntax.(Type_def (id_name,id_loc,Type_atom(type_expr,type_expr_loc,[]),K []))) sg
with
| Environment.Signature1.Duplicate_type_definition ->
emit_parse_error (Error.Duplicated_type id_name) id_loc
......@@ -74,40 +74,43 @@ sig_entry_eoi :
| dec = term_dec_start COLON type_exp = type_expression
{
fun s e ->
let dec',s' = dec s in
List.fold_left
(fun acc ((id,loc),kind) ->
try
let ty = fst (type_exp s e) in
let ty = fst (type_exp acc) in
Environment.Signature1.add_entry (Abstract_syntax.Term_decl (id,kind,loc,ty)) acc
with
| Environment.Signature1.Duplicate_term_definition ->
emit_parse_error (Error.Duplicated_term id) loc)
s
(dec s e)
s'
dec'
}
%inline term_dec_start :
| ids = separated_nonempty_list(COMMA,IDENT) { List.map (fun id -> (id,Abstract_syntax.Default)) ids }
| PREFIX sym = SYMBOL { [sym,Abstract_syntax.Prefix] }
| INFIX sym = SYMBOL { [sym,Abstract_syntax.Infix] }
| BINDER id = IDENT { [id,Abstract_syntax.Binder] }
| ids = separated_nonempty_list(COMMA,IDENT) { fun sg -> List.map (fun id -> (id,Abstract_syntax.Default)) ids,sg }
| PREFIX sym = SYMBOL { fun sg -> [sym,Abstract_syntax.Prefix],sg }
| INFIX sym = SYMBOL { fun sg ->
let p,sg' = Environment.Signature1.new_precedence sg in
[sym,Abstract_syntax.Infix (p,Left)],sg }
| BINDER id = IDENT { fun sg -> [id,Abstract_syntax.Binder],sg }
term_definition :
| definition = type_or_term_definition_prefix ty = type_expression
{
fun sg _ ->
let (id,l),(term,term_loc) = definition in
if Environment.Signature1.is_constant term sg then
if fst (Environment.Signature1.is_constant term sg) then
try
let term = Abstract_syntax.Const (term,term_loc) in
let ty',_ = ty s in
Environment.Signature1.add_entry (Abstract_syntax.Term_def (id,Abstract_syntax.Default,l,term,ty')) s
let ty',_ = ty sg in
Environment.Signature1.add_entry (Abstract_syntax.Term_def (id,Abstract_syntax.Default,l,term,ty')) sg
with
| Environment.Signature1.Duplicate_term_definition ->
emit_parse_error (Error.Duplicated_term id) l
else
emit_parse_error (Error.Unknown_constant type_expr) type_expr_loc
emit_parse_error (Error.Unknown_constant term) term_loc
}
......@@ -116,7 +119,8 @@ sig_entry_eoi :
fun s _ ->
let id',l = id in
try
let term = t s in
(* Attention, BUG : pas de gestion des warnings !!! *)
let term,_,_ = t Typing_env.empty s [] in
let ty',_ = ty s in
Environment.Signature1.add_entry (Abstract_syntax.Term_def (id',Abstract_syntax.Default,l,term,ty')) s
with
......@@ -126,11 +130,12 @@ sig_entry_eoi :
| def = term_def_start EQUAL t = term COLON ty = type_expression
{
fun s _ ->
let (id,l),k = def in
let (id,l),k,s' = def s in
try
let term = t s in
let ty',_ = ty s in
Environment.Signature1.add_entry (Abstract_syntax.Term_def (id,k,l,term,ty')) s
(* Attention, BUG : pas de gestion des warnings !!! *)
let term,_,_ = t Typing_env.empty s' [] in
let ty',_ = ty s' in
Environment.Signature1.add_entry (Abstract_syntax.Term_def (id,k,l,term,ty')) s'
with
| Environment.Signature1.Duplicate_term_definition ->
emit_parse_error (Error.Duplicated_term id) l}
......@@ -139,6 +144,8 @@ sig_entry_eoi :
%inline term_def_start :
| PREFIX sym = SYMBOL {sym,Abstract_syntax.Prefix}
| INFIX sym = SYMBOL {sym,Abstract_syntax.Infix}
| BINDER id = IDENT {id,Abstract_syntax.Binder}
| PREFIX sym = SYMBOL {fun sg -> sym,Abstract_syntax.Prefix,sg}
| INFIX sym = SYMBOL {fun sg ->
let p,sg' = Environment.Signature1.new_precedence sg in
sym,Abstract_syntax.Infix (p,Abstract_syntax.Left),sg'}
| BINDER id = IDENT {fun sg -> id,Abstract_syntax.Binder,sg}
......@@ -35,8 +35,8 @@
match Environment.Signature1.is_constant id sg,Typing_env.mem id type_env with
| (true,_),false -> Abstract_syntax.Const (id,loc),loc,warnings
| (false,_),true -> Abstract_syntax.Var (id,loc),loc,warnings
| (true,_),true -> Abstract_syntax.Var (id,l),loc,(Error.Variable_or_constant (id,loc))::warnings
| false,false -> emit_parse_error (Error.Unknown_constant_nor_variable id) (fst l,snd l)
| (true,_),true -> Abstract_syntax.Var (id,loc),loc,(Error.Variable_or_constant (id,loc))::warnings
| (false,_),false -> emit_parse_error (Error.Unknown_constant_nor_variable id) loc
}
| t = not_atomic_term { t }
......@@ -47,11 +47,11 @@
%public not_atomic_term:
| t1 = term0 terms = term0+
{ fun type_env sg warning ->
let t1,l1, ws = t1 type_env sg warning in
let t1, ws = t1 type_env sg warning in
let terms,warnings =
List.fold_left
(fun (lst,ws) t ->
let t',_,ws'= t type_env sg ws in
let t',ws'= t type_env sg ws in
t'::lst,ws')
([],ws)
terms in
......@@ -129,25 +129,28 @@
| id = atomic_type_or_term
{
fun type_env sg warnings ->
let id,loc = t in
let id,loc = id in
let t,ws =
match Environment.Signature1.is_constant id sg,Typing_env.mem id type_env with
| (true,_),false -> Abstract_syntax.Const (id,loc),warnings
| (false,_),true -> Abstract_syntax.Var (id,loc),warnings
| (true,_),true -> Abstract_syntax.Var (id,l),(Error.Variable_or_constant (id,loc))::warnings
| false,false -> emit_parse_error (Error.Unknown_constant_nor_variable id) (fst l,snd l) in
Term_sequence.Term t,ws }
| (true,_),true -> Abstract_syntax.Var (id,loc),(Error.Variable_or_constant (id,loc))::warnings
| (false,_),false -> emit_parse_error (Error.Unknown_constant_nor_variable id) loc in
Term_sequence.Term (t,loc),ws }
| id = SYMBOL
{
fun type_env sg warnings ->
let name,loc = id in
match Environment.Signature1.is_constant name sg with
| true,Some fix -> Op (name,fix,loc),warnings
| true,Some fix -> Op (Abstract_syntax.Const (name,loc),fix,loc),warnings
| true,None -> failwith "Bug: Should no happen"
| false,_ -> emit_parse_error (Error.Unknown_constant id) loc
| false,_ -> emit_parse_error (Error.Unknown_constant name) loc
}
| LPAREN t = not_atomic_term RPAREN
{ Term_sequence.Term t }
{
fun type_env sg warnings ->
let term,loc,ws = t type_env sg warnings in
Term_sequence.Term (term,loc),ws }
main: LAMBDA IDENT DOT RPAREN
##
## Ends in an error in state: 7.
##
## term1 -> LAMBDA nonempty_list(IDENT) DOT . term1 [ RPAREN EOI ]
##
## The known suffix of the stack is as follows:
## LAMBDA nonempty_list(IDENT) DOT
##
main: RPAREN
##
## Ends in an error in state: 0.
##
## main' -> . main [ # ]
##
## The known suffix of the stack is as follows:
##
##
main: SYMBOL RPAREN
##
## Ends in an error in state: 15.
##
## main -> term1 . EOI [ # ]
##
## The known suffix of the stack is as follows:
## term1
##
## WARNING: This example involves spurious reductions.
## This implies that, although the LR(1) items shown above provide an
## accurate view of the past (what has been recognized so far), they
## may provide an INCOMPLETE view of the future (what was expected next).
## In state 10, spurious reduction of production nonempty_list(term0) -> term0
## In state 12, spurious reduction of production term1 -> nonempty_list(term0)
##
This closing parenthesis doesn't have a matching opening parenthesis
main: LAMBDA IDENT SYMBOL
##
## Ends in an error in state: 4.
##
## nonempty_list(IDENT) -> IDENT . [ DOT ]
## nonempty_list(IDENT) -> IDENT . nonempty_list(IDENT) [ DOT ]
##
## The known suffix of the stack is as follows:
## IDENT
##
main: LAMBDA SYMBOL
##
## Ends in an error in state: 3.
##
## term1 -> LAMBDA . nonempty_list(IDENT) DOT term1 [ RPAREN EOI ]
##
## The known suffix of the stack is as follows:
## LAMBDA
##
After a binder (e.g., "lambda"), variable names are expected.
main: LPAREN RPAREN
##
## Ends in an error in state: 2.
##
## term0 -> LPAREN . term1 RPAREN [ SYMBOL RPAREN LPAREN IDENT EOI ] <