Commit 460e93f8 authored by Andrei Paskevich's avatar Andrei Paskevich

switch Typing to the new Dterm-based API

Also:

- Make [Highord.pred 'a] an alias for [Highord.func 'a bool],
rename [Highorg.(@!)] to [(@)], remove [Highorg.(@?)], remove
the quantifiers [\!] and [\?] and only leave [\] which is the
only true lambda now;

- Allow mixing bool and Prop in logic, Dterm will introduce
coercions where necessary (trying to minimize the number of
if-then-else in the term context).
parent fc68f4f7
......@@ -113,7 +113,7 @@ LIB_UTIL = config util opt lists strings extmap extset exthtbl weakhtbl \
LIB_CORE = ident ty term pattern decl theory \
task pretty dterm env trans printer
LIB_PARSER = ptree denv glob parser typing lexer
LIB_PARSER = ptree glob parser typing lexer
LIB_DRIVER = call_provers driver_ast driver_parser driver_lexer driver \
whyconf autodetection
......
......@@ -8,8 +8,7 @@ end
theory HighOrd
syntax type func "((%1) -> (%2))"
syntax type pred "((%1) -> bool)"
syntax function (@!) "((%1) (%2))"
syntax predicate (@?) "((%1) (%2))"
syntax function (@) "((%1) (%2))"
end
theory option.Option
......
This diff is collapsed.
......@@ -40,13 +40,12 @@ and dpattern_node =
type dterm = private {
dt_node : dterm_node;
dt_dty : dty option;
dt_label : Slab.t;
dt_loc : Loc.position option;
dt_uloc : Loc.position option;
}
and dterm_node =
| DTvar of string
| DTvar of string * dty
| DTgvar of vsymbol
| DTconst of Number.constant
| DTapp of lsymbol * dterm list
| DTif of dterm * dterm * dterm
......@@ -58,6 +57,9 @@ and dterm_node =
| DTnot of dterm
| DTtrue
| DTfalse
| DTcast of dterm * ty
| DTuloc of dterm * Loc.position
| DTlabel of dterm * Slab.t
(** Environment *)
......@@ -66,7 +68,9 @@ exception FmlaExpected
exception DuplicateVar of string
exception UnboundVar of string
type denv (** bound variables *)
type denv = dterm_node Mstr.t (** bound variables *)
val denv_empty : denv (** Mstr.empty *)
val denv_add_var : denv -> preid -> dty -> denv
......@@ -76,7 +80,9 @@ val denv_add_quant : denv -> (preid * dty) list -> denv
val denv_add_pat : denv -> dpattern -> denv
val denv_get_var : ?loc:Loc.position -> denv -> string -> dterm
val denv_get : denv -> string -> dterm_node (** raises UnboundVar *)
val denv_get_opt : denv -> string -> dterm_node option
(** Constructors *)
......@@ -84,15 +90,7 @@ val dpattern : ?loc:Loc.position -> dpattern_node -> dpattern
val dterm : ?loc:Loc.position -> dterm_node -> dterm
val dterm_type_cast : dterm -> ty -> dterm
val dterm_add_label : dterm -> label -> dterm
val dterm_set_labels : dterm -> Slab.t -> dterm
val dterm_set_uloc : dterm -> Loc.position -> dterm
(** Final stage *)
val term : strict:bool -> keep_loc:bool -> vsymbol Mstr.t -> dterm -> term
val fmla : strict:bool -> keep_loc:bool -> vsymbol Mstr.t -> dterm -> term
......@@ -829,20 +829,13 @@ let t_tuple tl =
let fs_func_app =
let ty_a = ty_var (create_tvsymbol (id_fresh "a")) in
let ty_b = ty_var (create_tvsymbol (id_fresh "b")) in
create_fsymbol (id_fresh "infix @!") [ty_func ty_a ty_b; ty_a] ty_b
let ps_pred_app =
let ty_a = ty_var (create_tvsymbol (id_fresh "a")) in
create_psymbol (id_fresh "infix @?") [ty_pred ty_a; ty_a]
create_fsymbol (id_fresh "infix @") [ty_func ty_a ty_b; ty_a] ty_b
let t_func_app fn t = t_app_infer fs_func_app [fn; t]
let t_pred_app pr t = ps_app ps_pred_app [pr; t]
let t_func_app_l = List.fold_left t_func_app
let t_pred_app pr t = t_equ (t_func_app pr t) t_bool_true
let t_pred_app_l pr tl = match List.rev tl with
| t::tl -> t_pred_app (t_func_app_l pr (List.rev tl)) t
| _ -> Pervasives.invalid_arg "t_pred_app_l"
let t_func_app_l fn tl = List.fold_left t_func_app fn tl
let t_pred_app_l pr tl = t_equ (t_func_app_l pr tl) t_bool_true
(** Term library *)
......
......@@ -297,14 +297,13 @@ val t_tuple : term list -> term
val is_fs_tuple : lsymbol -> bool
val is_fs_tuple_id : ident -> int option
val fs_func_app : lsymbol (* value-typed higher-order application *)
val ps_pred_app : lsymbol (* prop-typed higher-order application *)
val fs_func_app : lsymbol (* higher-order application symbol *)
val t_func_app : term -> term -> term
val t_pred_app : term -> term -> term
val t_func_app : term -> term -> term (* value-typed application *)
val t_pred_app : term -> term -> term (* prop-typed application *)
val t_func_app_l : term -> term list -> term
val t_pred_app_l : term -> term list -> term
val t_func_app_l : term -> term list -> term (* value-typed application *)
val t_pred_app_l : term -> term list -> term (* prop-typed application *)
(** {2 Term library} *)
......
......@@ -836,10 +836,10 @@ let bool_theory =
let highord_theory =
let uc = empty_theory (id_fresh "HighOrd") ["why3"] in
let uc = use_export uc bool_theory in
let uc = add_ty_decl uc ts_func in
let uc = add_ty_decl uc ts_pred in
let uc = add_param_decl uc fs_func_app in
let uc = add_param_decl uc ps_pred_app in
close_theory uc
let tuple_theory = Hint.memo 17 (fun n ->
......
......@@ -220,11 +220,13 @@ let ts_func =
let tv_b = create_tvsymbol (id_fresh "b") in
create_tysymbol (id_fresh "func") [tv_a;tv_b] None
let ty_func ty_a ty_b = ty_app ts_func [ty_a;ty_b]
let ts_pred =
let tv_a = create_tvsymbol (id_fresh "a") in
create_tysymbol (id_fresh "pred") [tv_a] None
let def = Some (ty_func (ty_var tv_a) ty_bool) in
create_tysymbol (id_fresh "pred") [tv_a] def
let ty_func ty_a ty_b = ty_app ts_func [ty_a;ty_b]
let ty_pred ty_a = ty_app ts_pred [ty_a]
let ts_tuple_ids = Hid.create 17
......
......@@ -115,7 +115,7 @@ val ts_func : tysymbol
val ts_pred : tysymbol
val ty_func : ty -> ty -> ty
val ty_pred : ty -> ty
val ty_pred : ty -> ty (* ty_pred 'a == ty_func 'a bool *)
val ts_tuple : int -> tysymbol
val ty_tuple : ty list -> ty
......
(********************************************************************)
(* *)
(* The Why3 Verification Platform / The Why3 Development Team *)
(* Copyright 2010-2013 -- INRIA - CNRS - Paris-Sud University *)
(* *)
(* This software is distributed under the terms of the GNU Lesser *)
(* General Public License version 2.1, with the special exception *)
(* on linking described in file LICENSE. *)
(* *)
(********************************************************************)
open Format
open Pp
open Stdlib
open Ident
open Ptree
open Ty
open Term
(** types with destructive type variables *)
type dty_view =
| Tyvar of type_var
| Tyuvar of tvsymbol
| Tyapp of tysymbol * dty_view list
and type_var = {
tag : int;
tvsymbol : tvsymbol;
mutable type_val : dty_view option;
type_var_loc : loc option;
}
let tyuvar tv = Tyuvar tv
let rec type_inst s ty = match ty.ty_node with
| Ty.Tyvar n -> Mtv.find n s
| Ty.Tyapp (ts, tyl) -> Tyapp (ts, List.map (type_inst s) tyl)
let tyapp ts tyl = match ts.ts_def with
| None ->
Tyapp (ts, tyl)
| Some ty ->
let add m v t = Mtv.add v t m in
try
let s = List.fold_left2 add Mtv.empty ts.ts_args tyl in
type_inst s ty
with Invalid_argument _ ->
Loc.errorm "this type expects %d parameters" (List.length ts.ts_args)
type dty = dty_view
let rec print_dty fmt = function
| Tyvar { type_val = Some t } ->
print_dty fmt t
| Tyvar { type_val = None; tvsymbol = tv }
| Tyuvar tv ->
Pretty.print_tv fmt tv
| Tyapp (s, []) ->
fprintf fmt "%s" s.ts_name.id_string
| Tyapp (s, [t]) ->
fprintf fmt "%s %a" s.ts_name.id_string print_dty t
| Tyapp (s, l) ->
fprintf fmt "%s %a" s.ts_name.id_string (print_list space print_dty) l
let create_ty_decl_var =
let t = ref 0 in
fun ?loc tv ->
incr t;
{ tag = !t; tvsymbol = tv; type_val = None; type_var_loc = loc }
let fresh_type_var loc =
let tv = create_tvsymbol (id_user "a" loc) in
Tyvar (create_ty_decl_var ~loc tv)
let rec occurs v = function
| Tyvar { type_val = Some t } -> occurs v t
| Tyvar { tag = t; type_val = None } -> v.tag = t
| Tyuvar _ -> false
| Tyapp (_, l) -> List.exists (occurs v) l
(* destructive type unification *)
let rec unify t1 t2 = match t1, t2 with
| Tyvar { type_val = Some t1 }, _ ->
unify t1 t2
| _, Tyvar { type_val = Some t2 } ->
unify t1 t2
| Tyvar v1, Tyvar v2 when v1.tag = v2.tag ->
true
(* instantiable variables *)
| Tyvar v, t | t, Tyvar v ->
not (occurs v t) && (v.type_val <- Some t; true)
(* recursive types *)
| Tyapp (s1, l1), Tyapp (s2, l2) ->
ts_equal s1 s2 && List.length l1 = List.length l2 &&
List.for_all2 unify l1 l2
| Tyapp _, _ | _, Tyapp _ ->
false
(* other cases *)
| Tyuvar tv1, Tyuvar tv2 ->
tv_equal tv1 tv2
(* intermediate types -> types *)
let rec ty_of_dty = function
| Tyvar { type_val = Some t } ->
ty_of_dty t
| Tyvar { type_val = None; type_var_loc = loc } ->
Loc.errorm ?loc "undefined type variable"
| Tyuvar tv ->
ty_var tv
| Tyapp (s, tl) ->
ty_app s (List.map ty_of_dty tl)
let rec dty_of_ty ty = match ty.ty_node with
| Ty.Tyvar tv -> Tyuvar tv
| Ty.Tyapp (ts,tl) -> Tyapp (ts, List.map dty_of_ty tl)
type ident = Ptree.ident
type dpattern = { dp_node : dpattern_node; dp_ty : dty }
and dpattern_node =
| Pwild
| Pvar of ident
| Papp of lsymbol * dpattern list
| Por of dpattern * dpattern
| Pas of dpattern * ident
let create_user_id { id = x ; id_lab = ll ; id_loc = loc } =
let get_labels (ll,p) = function
| Lstr l -> Slab.add l ll, p
| Lpos p -> ll, Some p
in
let label,p = List.fold_left get_labels (Slab.empty,None) ll in
id_user ~label x (Opt.get_def loc p)
let create_user_vs id ty = create_vsymbol (create_user_id id) ty
let rec pattern_env env p = match p.dp_node with
| Pwild -> env
| Papp (_, pl) -> List.fold_left pattern_env env pl
| Por (p, _) -> pattern_env env p
| Pvar id ->
let vs = create_user_vs id (ty_of_dty p.dp_ty) in
Mstr.add id.id vs env
| Pas (p, id) ->
let vs = create_user_vs id (ty_of_dty p.dp_ty) in
pattern_env (Mstr.add id.id vs env) p
let get_pat_var env p x = try Mstr.find x env with Not_found ->
raise (Term.UncoveredVar (create_vsymbol (id_fresh x) (ty_of_dty p.dp_ty)))
let rec pattern_pat env p = match p.dp_node with
| Pwild -> pat_wild (ty_of_dty p.dp_ty)
| Pvar x -> pat_var (get_pat_var env p x.id)
| Pas (p, x) -> pat_as (pattern_pat env p) (get_pat_var env p x.id)
| Por (p, q) -> pat_or (pattern_pat env p) (pattern_pat env q)
| Papp (s, pl) ->
pat_app s (List.map (pattern_pat env) pl) (ty_of_dty p.dp_ty)
let pattern env p = let env = pattern_env env p in env, pattern_pat env p
type dterm = { dt_node : dterm_node; dt_ty : dty }
and dterm_node =
| Tvar of string
| Tgvar of vsymbol
| Tconst of constant
| Tapp of lsymbol * dterm list
| Tif of dfmla * dterm * dterm
| Tlet of dterm * ident * dterm
| Tmatch of dterm * (dpattern * dterm) list
| Tnamed of label * dterm
| Teps of ident * dty * dfmla
and dfmla =
| Fapp of lsymbol * dterm list
| Fquant of quant * (ident * dty) list * dtrigger list list * dfmla
| Fbinop of binop * dfmla * dfmla
| Fnot of dfmla
| Ftrue
| Ffalse
| Fif of dfmla * dfmla * dfmla
| Flet of dterm * ident * dfmla
| Fmatch of dterm * (dpattern * dfmla) list
| Fnamed of label * dfmla
| Fvar of term
and dtrigger =
| TRterm of dterm
| TRfmla of dfmla
let allowed_unused s = String.length s > 0 && s.[0] = '_'
let check_used_var vars v =
if not (Mvs.mem v vars) then
let s = v.vs_name.id_string in
if not (allowed_unused s) then
Warning.emit ?loc:v.vs_name.Ident.id_loc "unused variable %s" s
let check_used_vars vars =
List.iter (check_used_var vars)
let check_exists_implies q f =
match q,f.t_node with
| Texists, Tbinop(Timplies, _,_) ->
Warning.emit ?loc:f.t_loc "form \"exists, P -> Q\" is likely an error (use \"not P \\/ Q\" if not)"
| _ -> ()
let rec term env t = match t.dt_node with
| Tvar x ->
assert (Mstr.mem x env);
t_var (Mstr.find x env)
| Tgvar vs ->
t_var vs
| Tconst c ->
t_const c
| Tapp (s, tl) ->
fs_app s (List.map (term env) tl) (ty_of_dty t.dt_ty)
| Tif (f, t1, t2) ->
t_if (fmla env f) (term env t1) (term env t2)
| Tlet (e1, id, e2) ->
let e1 = term env e1 in
let v = create_user_vs id (t_type e1) in
let env = Mstr.add id.id v env in
let e2 = term env e2 in
check_used_var e2.t_vars v;
t_let_close v e1 e2
| Tmatch (t1, bl) ->
let branch (p,e) =
let env, p = pattern env p in t_close_branch p (term env e)
in
t_case (term env t1) (List.map branch bl)
| Tnamed _ ->
let rec collect p ll e = match e.dt_node with
| Tnamed (Lstr l, e) -> collect p (Slab.add l ll) e
| Tnamed (Lpos p, e) -> collect (Some p) ll e
| _ -> t_label ?loc:p ll (term env e)
in
collect None Slab.empty t
| Teps (id, ty, e1) ->
let v = create_user_vs id (ty_of_dty ty) in
let env = Mstr.add id.id v env in
let e1 = fmla env e1 in
t_eps_close v e1
and fmla env = function
| Ftrue ->
t_true
| Ffalse ->
t_false
| Fnot f ->
t_not (fmla env f)
| Fbinop (op, f1, f2) ->
t_binary op (fmla env f1) (fmla env f2)
| Fif (f1, f2, f3) ->
t_if (fmla env f1) (fmla env f2) (fmla env f3)
| Fquant (q, uqu, trl, f1) ->
let uquant env (id,ty) =
let v = create_user_vs id (ty_of_dty ty) in
Mstr.add id.id v env, v
in
let env, vl = Lists.map_fold_left uquant env uqu in
let trigger = function
| TRterm t -> term env t
| TRfmla f -> fmla env f
in
let trl = List.map (List.map trigger) trl in
let f = fmla env f1 in
check_used_vars f.Term.t_vars vl;
check_exists_implies q f;
t_quant_close q vl trl f
| Fapp (s, tl) ->
ps_app s (List.map (term env) tl)
| Flet (e1, id, f2) ->
let e1 = term env e1 in
let v = create_user_vs id (t_type e1) in
let env = Mstr.add id.id v env in
let f2 = fmla env f2 in
check_used_var f2.t_vars v;
t_let_close v e1 f2
| Fmatch (t, bl) ->
let branch (p,e) =
let env, p = pattern env p in t_close_branch p (fmla env e)
in
t_case (term env t) (List.map branch bl)
| (Fnamed _) as f ->
let rec collect p ll = function
| Fnamed (Lstr l, e) -> collect p (Slab.add l ll) e
| Fnamed (Lpos p, e) -> collect (Some p) ll e
| e -> t_label ?loc:p ll (fmla env e)
in
collect None Slab.empty f
| Fvar f ->
f
(* Specialize *)
let find_type_var ~loc env tv =
try
Htv.find env tv
with Not_found ->
let v = create_ty_decl_var ~loc tv in
Htv.add env tv v;
v
let rec specialize_ty ~loc env t = match t.ty_node with
| Ty.Tyvar tv ->
Tyvar (find_type_var ~loc env tv)
| Ty.Tyapp (s, tl) ->
Tyapp (s, List.map (specialize_ty ~loc env) tl)
let specialize_lsymbol ~loc s =
let tl = s.ls_args in
let t = s.ls_value in
let env = Htv.create 17 in
List.map (specialize_ty ~loc env) tl, Opt.map (specialize_ty ~loc env) t
(********************************************************************)
(* *)
(* The Why3 Verification Platform / The Why3 Development Team *)
(* Copyright 2010-2013 -- INRIA - CNRS - Paris-Sud University *)
(* *)
(* This software is distributed under the terms of the GNU Lesser *)
(* General Public License version 2.1, with the special exception *)
(* on linking described in file LICENSE. *)
(* *)
(********************************************************************)
open Stdlib
open Ty
open Term
open Theory
(** Destructive unification *)
type dty
val tyuvar : tvsymbol -> dty
val tyapp : tysymbol -> dty list -> dty
val fresh_type_var : Ptree.loc -> dty
val unify : dty -> dty -> bool
val print_dty : Format.formatter -> dty -> unit
val ty_of_dty : dty -> ty
val dty_of_ty : ty -> dty
type ident = Ptree.ident
val create_user_id : Ptree.ident -> Ident.preid
type dpattern = { dp_node : dpattern_node; dp_ty : dty }
and dpattern_node =
| Pwild
| Pvar of ident
| Papp of lsymbol * dpattern list
| Por of dpattern * dpattern
| Pas of dpattern * ident
val pattern : vsymbol Mstr.t -> dpattern -> vsymbol Mstr.t * pattern
type dterm = { dt_node : dterm_node; dt_ty : dty }
and dterm_node =
| Tvar of string
| Tgvar of vsymbol
| Tconst of Number.constant
| Tapp of lsymbol * dterm list
| Tif of dfmla * dterm * dterm
| Tlet of dterm * ident * dterm
| Tmatch of dterm * (dpattern * dterm) list
| Tnamed of Ptree.label * dterm
| Teps of ident * dty * dfmla
and dfmla =
| Fapp of lsymbol * dterm list
| Fquant of quant * (ident * dty) list * dtrigger list list * dfmla
| Fbinop of binop * dfmla * dfmla
| Fnot of dfmla
| Ftrue
| Ffalse
| Fif of dfmla * dfmla * dfmla
| Flet of dterm * ident * dfmla
| Fmatch of dterm * (dpattern * dfmla) list
| Fnamed of Ptree.label * dfmla
| Fvar of term
and dtrigger =
| TRterm of dterm
| TRfmla of dfmla
val term : vsymbol Mstr.t -> dterm -> term
val fmla : vsymbol Mstr.t -> dfmla -> term
(** Specialization *)
val specialize_lsymbol : loc:Ptree.loc -> lsymbol -> dty list * dty option
......@@ -240,10 +240,6 @@ rule token = parse
{ OR }
| "\\"
{ LAMBDA }
| "\\?"
{ PRED }
| "\\!"
{ FUNC }
| "."
{ DOT }
| "|"
......
......@@ -37,13 +37,6 @@ end
let floc_ij i j = Loc.extract (loc_ij i j)
*)
let pty_of_id i = PPTtyapp (Qident i, [])
let params_of_binders bl = List.map (function
| l, None, _, None -> Loc.errorm ~loc:l "cannot determine the type"
| l, Some i, gh, None -> l, None, gh, pty_of_id i
| l, i, gh, Some t -> l, i, gh, t) bl
let quvars_of_lidents ty ll = List.map (function
| l, None -> Loc.errorm ~loc:l "anonymous binders are not allowed here"
| _, Some i -> i, ty) ll
......@@ -69,6 +62,10 @@ end
let add_lab id l = { id with id_lab = l }
let rec mk_l_apply f a =
let loc = Loc.join f.pp_loc a.pp_loc in
{ pp_loc = loc; pp_desc = PPhoapp (f,a) }
let mk_l_prefix op e1 =
let id = mk_id (prefix op) (floc_i 1) in
mk_pp (PPapp (Qident id, [e1]))
......@@ -207,9 +204,9 @@ end
%token AND ARROW
%token BAR
%token COLON COMMA
%token DOT EQUAL FUNC LAMBDA LTGT
%token DOT EQUAL LAMBDA LTGT
%token LEFTPAR LEFTPAR_STAR_RIGHTPAR LEFTSQ
%token LARROW LRARROW OR PRED
%token LARROW LRARROW OR
%token RIGHTPAR RIGHTSQ
%token UNDERSCORE
......@@ -568,13 +565,9 @@ indcase:
/* Type expressions */
primitive_type:
| primitive_type_arg { $1 }
| lqualid primitive_type_args { PPTtyapp ($1, $2) }
;
primitive_type_non_lident:
| primitive_type_arg_non_lident { $1 }
| uqualid DOT lident primitive_type_args { PPTtyapp (Qdot ($1, $3), $4) }
| primitive_type_arg { $1 }
| lqualid primitive_type_args { PPTtyapp ($1, $2) }
| primitive_type ARROW primitive_type { PPTarrow ($1, $3) }
;
primitive_type_args:
......@@ -582,19 +575,9 @@ primitive_type_args:
| primitive_type_arg primitive_type_args { $1 :: $2 }
;
primitive_type_args_non_lident:
| primitive_type_arg_non_lident { [$1] }
| primitive_type_arg_non_lident primitive_type_args { $1 :: $2 }
;
primitive_type_arg:
| lident { PPTtyapp (Qident $1, []) }
| primitive_type_arg_non_lident { $1 }
;
primitive_type_arg_non_lident:
| uqualid DOT lident
{ PPTtyapp (Qdot ($1, $3), []) }
| lqualid
{ PPTtyapp ($1, []) }
| quote_lident
{ PPTtyvar ($1, false) }
| opaque_quote_lident
......@@ -604,7 +587,7 @@ primitive_type_arg_non_lident:
| LEFTPAR RIGHTPAR
{ PPTtuple [] }
| LEFTPAR primitive_type RIGHTPAR
{ $2 }
{ PPTparen $2 }
;
list1_primitive_type_sep_comma:
......@@ -645,6 +628,8 @@ lexpr:
{ mk_l_prefix $1 $2 }
| qualid list1_lexpr_arg
{ mk_pp (PPapp ($1, $2)) }
| lexpr_arg_noid list1_lexpr_arg
{ List.fold_left mk_l_apply $1 $2 }
| IF lexpr THEN lexpr ELSE lexpr
{ mk_pp (PPif ($2, $4, $6)) }
| quant list1_quant_vars triggers DOT lexpr
......@@ -662,10 +647,6 @@ lexpr:
{ mk_pp (PPmatch ($2, $5)) }
| MATCH lexpr COMMA list1_lexpr_sep_comma WITH bar_ match_cases END
{ mk_pp (PPmatch (mk_pp (PPtuple ($2::$4)), $7)) }
/*
| EPSILON lident labels COLON primitive_type DOT lexpr
{ mk_pp (PPeps ((add_lab $2 $3, Some $5), $7)) }
*/
| lexpr COLON primitive_type
{ mk_pp (PPcast ($1, $3)) }
| lexpr_arg
......@@ -695,6 +676,10 @@ constant:
lexpr_arg:
| qualid { mk_pp (PPvar $1) }
| lexpr_arg_noid { $1 }
;
lexpr_arg_noid:
| constant { mk_pp (PPconst $1) }
| TRUE { mk_pp PPtrue }
| FALSE { mk_pp PPfalse }
......@@ -732,8 +717,6 @@ quant:
| FORALL { PPforall }
| EXISTS { PPexists }
| LAMBDA { PPlambda }
| FUNC { PPfunc }
| PRED { PPpred }
;
/* Triggers */
......@@ -820,7 +803,8 @@ list0_param:
;
list1_param:
| list1_binder { params_of_binders $1 }
| param { $1 }
| param list1_param { $1 @ $2 }
;
list1_binder:
......@@ -828,75 +812,97 @@ list1_binder:
| binder list1_binder { $1 @ $2 }
;
/* [param] and [binder] below must have the same grammar and
raise [Parse_error] in the same cases. Interpretaion of
single-standing untyped [Qident]'s is different: [param]