Commit 82033fd6 authored by Andrei Paskevich's avatar Andrei Paskevich
Browse files

add missing checks in create_tysymbol

parent 6791bf05
...@@ -105,13 +105,22 @@ module Ty = struct ...@@ -105,13 +105,22 @@ module Ty = struct
let ty_exists pr ty = let ty_exists pr ty =
try ty_fold (exists_fn pr) false ty with FoldSkip -> true try ty_fold (exists_fn pr) false ty with FoldSkip -> true
(* set of free type variables *) (* smart constructors *)
let rec ty_vars acc ty = match ty.ty_node with let tv_add_unique vs tv = if Name.S.mem tv vs
| Tyvar u -> Name.S.add u acc then raise NonLinearPattern else Name.S.add tv vs
| _ -> ty_fold ty_vars acc ty
(* smart constructors *) let rec tv_known vs ty = match ty.ty_node with
| Tyvar n -> Name.S.mem n vs
| _ -> ty_forall (tv_known vs) ty
let create_tysymbol name args def =
let tvs = List.fold_left tv_add_unique Name.S.empty args in
let _ = match def with
| Some ty -> tv_known tvs ty || raise UnboundVariable
| _ -> true
in
create_tysymbol name args def
exception BadTypeArity exception BadTypeArity
...@@ -119,6 +128,8 @@ module Ty = struct ...@@ -119,6 +128,8 @@ module Ty = struct
if List.length tl == List.length s.ts_args if List.length tl == List.length s.ts_args
then ty_app s tl else raise BadTypeArity then ty_app s tl else raise BadTypeArity
(* type matching *)
exception TypeMismatch exception TypeMismatch
let rec matching s ty1 ty2 = let rec matching s ty1 ty2 =
...@@ -672,8 +683,8 @@ let rec t_vars lvl acc t = match t.t_node with ...@@ -672,8 +683,8 @@ let rec t_vars lvl acc t = match t.t_node with
and f_vars lvl acc t = f_fold_unsafe t_vars f_vars lvl acc t and f_vars lvl acc t = f_fold_unsafe t_vars f_vars lvl acc t
let t_vars s t = t_vars 0 s t let t_freevars s t = t_vars 0 s t
let f_vars s f = f_vars 0 s f let f_freevars s f = f_vars 0 s f
(* USE PHYSICAL EQUALITY *) (* USE PHYSICAL EQUALITY *)
(* (*
......
...@@ -49,7 +49,6 @@ module Ty : sig ...@@ -49,7 +49,6 @@ module Ty : sig
val ty_fold : ('a -> ty -> 'a) -> 'a -> ty -> 'a val ty_fold : ('a -> ty -> 'a) -> 'a -> ty -> 'a
val ty_forall : (ty -> bool) -> ty -> bool val ty_forall : (ty -> bool) -> ty -> bool
val ty_exists : (ty -> bool) -> ty -> bool val ty_exists : (ty -> bool) -> ty -> bool
val ty_vars : Name.S.t -> ty -> Name.S.t
val ty_match : ty -> ty -> ty Name.M.t -> ty Name.M.t option val ty_match : ty -> ty -> ty Name.M.t -> ty Name.M.t option
...@@ -268,8 +267,8 @@ val f_subst_single : vsymbol -> term -> fmla -> fmla ...@@ -268,8 +267,8 @@ val f_subst_single : vsymbol -> term -> fmla -> fmla
(* set of free variables *) (* set of free variables *)
val t_vars : Svs.t -> term -> Svs.t val t_freevars : Svs.t -> term -> Svs.t
val f_vars : Svs.t -> fmla -> Svs.t val f_freevars : Svs.t -> fmla -> Svs.t
(* USE PHYSICAL EQUALITY *) (* USE PHYSICAL EQUALITY *)
(* (*
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment