module Ast = NotationPt
+type ident_or_var =
+ Ident of string
+ | Var of string
+
type value =
| TermValue of Ast.term
- | StringValue of string
+ | StringValue of ident_or_var
| NumValue of string
| OptValue of value option
| ListValue of value list
let value_of_term = function
| Ast.Num (s, _) -> NumValue s
- | Ast.Ident (s, None) -> StringValue s
+ | Ast.Ident (s, None) -> StringValue (Var s)
| t -> TermValue t
let term_of_value = function
| NumValue s -> Ast.Num (s, 0)
- | StringValue s -> Ast.Ident (s, None)
+ | StringValue (Ident s) -> Ast.Ident (s, None)
| TermValue t -> t
| _ -> assert false (* TO BE UNDERSTOOD *)
let min_precedence = 0
let max_precedence = 100
-type ('a,'b,'c,'d) grammars = {
+type ('a,'b,'c,'d,'e) grammars = {
level1_pattern: 'a Grammar.Entry.e;
level2_ast: 'b Grammar.Entry.e;
level2_ast_grammar : Grammar.g;
term: 'b Grammar.Entry.e;
+ ident: 'e Grammar.Entry.e;
let_defs: 'c Grammar.Entry.e;
protected_binder_vars: 'd Grammar.Entry.e;
level2_meta: 'b Grammar.Entry.e;
Ast.term,
(Ast.term Ast.capture_variable list *
Ast.term Ast.capture_variable * Ast.term * int) list,
- Ast.term list * Ast.term option) grammars;
+ Ast.term list * Ast.term option, Env.ident_or_var) grammars;
keywords: string list;
items: (string * Ast.term * (NotationEnv.t -> Ast.location -> Ast.term)) list
}
string_of_int precedence
let gram_symbol s = Gramext.Stoken ("SYMBOL", s)
-let gram_ident s = Gramext.Stoken ("IDENT", s)
+let gram_ident status =
+ Gramext.Snterm (Grammar.Entry.obj
+ (status#notation_parser_db.grammars.ident : 'a Grammar.Entry.e))
+ (*Gramext.Stoken ("IDENT", s)*)
let gram_number s = Gramext.Stoken ("NUMBER", s)
let gram_keyword s = Gramext.Stoken ("", s)
let gram_term status = function
aux ((name, (Env.TermType l, Env.TermValue v))::vl) tl)
| Binding (name, Env.StringType) :: tl ->
Gramext.action
- (fun (v:string) ->
+ (fun (v:Env.ident_or_var) ->
aux ((name, (Env.StringType, Env.StringValue v)) :: vl) tl)
| Binding (name, Env.NumType) :: tl ->
Gramext.action
| Ast.NumVar s -> [Binding (s, Env.NumType), gram_number ""]
| Ast.TermVar (s,(Ast.Self level|Ast.Level level as lv)) ->
[Binding (s, Env.TermType level), gram_term status lv]
- | Ast.IdentVar s -> [Binding (s, Env.StringType), gram_ident ""]
+ | Ast.IdentVar s -> [Binding (s, Env.StringType), gram_ident status]
| Ast.Ascription (p, s) -> assert false (* TODO *)
| Ast.FreshVar _ -> assert false
and inner_pattern p =
let level2_ast = grammars.level2_ast in
let term = grammars.term in
let let_defs = grammars.let_defs in
+ let ident = grammars.ident in
let protected_binder_vars = grammars.protected_binder_vars in
EXTEND
- GLOBAL: level2_ast term let_defs protected_binder_vars;
+ GLOBAL: level2_ast term let_defs protected_binder_vars ident;
level2_ast: [ [ p = term -> p ] ];
sort: [
[ "Prop" -> `Prop
| _ -> failwith "Invalid index name."
]
];
+ ident: [
+ [ name = IDENT -> Env.Ident name
+ | blob = UNPARSED_META ->
+ let meta = parse_level2_meta grammars (Ulexing.from_utf8_string blob) in
+ match meta with
+ | Ast.Variable (Ast.FreshVar _) ->
+ (* it makes sense: extend Env.ident_or_var *)
+ assert false
+ | Ast.Variable (Ast.IdentVar name) -> Env.Var name
+ | Ast.Variable (Ast.TermVar ("_",_)) -> Env.Var "_"
+ | _ -> failwith ("Invalid index name: " ^ blob)
+ ]
+ ];
let_defs: [
[ defs = LIST1 [
name = single_arg;
Grammar.Entry.create level1_pattern_grammar "level1_pattern" in
let level2_ast = Grammar.Entry.create level2_ast_grammar "level2_ast" in
let term = Grammar.Entry.create level2_ast_grammar "term" in
+ let ident = Grammar.Entry.create level2_ast_grammar "ident" in
let let_defs = Grammar.Entry.create level2_ast_grammar "let_defs" in
let protected_binder_vars =
Grammar.Entry.create level2_ast_grammar "protected_binder_vars" in
initialize_grammars { level1_pattern=level1_pattern;
level2_ast=level2_ast;
term=term;
+ ident=ident;
let_defs=let_defs;
protected_binder_vars=protected_binder_vars;
level2_meta=level2_meta;
(make_action
(fun (env: NotationEnv.t) (loc: Ast.location) ->
(action env loc))
- p_bindings) ]]];
+ p_bindings) ]]];
status
in
let current_item =
let instantiate_level2 env term =
(* prerr_endline ("istanzio: " ^ NotationPp.pp_term term); *)
+prerr_endline ("istanzio: " ^ NotationPp.pp_term term);
let fresh_env = ref [] in
let lookup_fresh_name n =
try
fresh_env := (n, new_name) :: !fresh_env;
new_name
in
+prerr_endline ("ENV " ^ NotationPp.pp_env env);
let rec aux env term =
-(* prerr_endline ("ENV " ^ NotationPp.pp_env env); *)
+prerr_endline ("istanzio_deep: " ^ NotationPp.pp_term term);
match term with
| Ast.AttributedTerm (a, term) -> (*Ast.AttributedTerm (a, *)aux env term
| Ast.Appl terms -> Ast.Appl (List.map (aux env) terms)
and aux_meta_substs env meta_substs = List.map (aux_opt env) meta_substs
and aux_variable env = function
| Ast.NumVar name -> Ast.Num (Env.lookup_num env name, 0)
- | Ast.IdentVar name -> Ast.Ident (Env.lookup_string env name, None)
+ | Ast.IdentVar name ->
+ (match Env.lookup_string env name with
+ Env.Ident x -> Ast.Ident (x, None)
+ | Env.Var x -> Ast.Variable (Ast.IdentVar x))
| Ast.TermVar (name,(Ast.Level l|Ast.Self l)) ->
Ast.AttributedTerm (`Level l,Env.lookup_term env name)
| Ast.FreshVar name -> Ast.Ident (lookup_fresh_name name, None)