- CicNotationEnv.term_of_value value
- | Ast.Magic _ -> assert false (* TO BE IMPLEMENTED *)
- | Ast.Literal _ as t -> t
- | Ast.Layout l -> Ast.Layout (subst_layout l)
- | t -> CicNotationUtil.visit_ast subst t
- and subst_layout l = CicNotationUtil.visit_layout subst l in
- subst l1
+ [ CicNotationEnv.term_of_value value ]
+ | Ast.Magic m -> subst_magic env m
+ | Ast.Literal (`Keyword k) as t ->
+ [ Ast.AttributedTerm (`XmlAttrs keyword_attributes, t) ]
+ | Ast.Literal _ as t -> [ t ]
+ | Ast.Layout l -> [ Ast.Layout (subst_layout env l) ]
+ | t -> [ CicNotationUtil.visit_ast (subst_singleton env) t ]
+ and subst_magic env = function
+ | Ast.List0 (p, sep_opt)
+ | Ast.List1 (p, sep_opt) ->
+ let rec_decls = CicNotationEnv.declarations_of_term p in
+ let rec_values =
+ List.map (fun (n, _) -> CicNotationEnv.lookup_list env n) rec_decls
+ in
+ let values = CicNotationUtil.ncombine rec_values in
+ let sep =
+ match sep_opt with
+ | None -> []
+ | Some l -> [ CicNotationPt.Literal l ]
+ in
+ let rec instantiate_list acc = function
+ | [] -> List.rev acc
+ | value_set :: [] ->
+ let env = CicNotationEnv.combine rec_decls value_set in
+ instantiate_list (CicNotationUtil.group (subst env p) :: acc) []
+ | value_set :: tl ->
+ let env = CicNotationEnv.combine rec_decls value_set in
+ instantiate_list (CicNotationUtil.group ((subst env p) @ sep) :: acc) tl
+ in
+ instantiate_list [] values
+ | Ast.Opt p ->
+ let opt_decls = CicNotationEnv.declarations_of_term p in
+ let env =
+ let rec build_env = function
+ | [] -> []
+ | (name, ty) :: tl ->
+ (* assumption: if one of the value is None then all are *)
+ (match CicNotationEnv.lookup_opt env name with
+ | None -> raise Exit
+ | Some v -> (name, (ty, v)) :: build_env tl)
+ in
+ try build_env opt_decls with Exit -> []
+ in
+ begin
+ match env with
+ | [] -> []
+ | _ -> subst env p
+ end
+ | _ -> assert false (* impossible *)
+ and subst_layout env = function
+ | Ast.Box (kind, tl) ->
+ Ast.Box (kind, List.concat (List.map (subst env) tl))
+ | l -> CicNotationUtil.visit_layout (subst_singleton env) l
+ in
+ subst_singleton env l1