aboutsummaryrefslogtreecommitdiffhomepage
path: root/kernel/sorts.ml
diff options
context:
space:
mode:
authorGravatar ppedrot <ppedrot@85f007b7-540e-0410-9357-904b9bb8a0f7>2013-04-29 16:02:05 +0000
committerGravatar ppedrot <ppedrot@85f007b7-540e-0410-9357-904b9bb8a0f7>2013-04-29 16:02:05 +0000
commit4490dfcb94057dd6518963a904565e3a4a354bac (patch)
treec35cdb94182d5c6e9197ee131d9fe2ebf5a7d139 /kernel/sorts.ml
parenta188216d8570144524c031703860b63f0a53b56e (diff)
Splitting Term into five unrelated interfaces:
1. sorts.ml: A small file utility for sorts; 2. constr.ml: Really low-level terms, essentially kind_of_constr, smart constructor and basic operators; 3. vars.ml: Everything related to term variables, that is, occurences and substitution; 4. context.ml: Rel/Named context and all that; 5. term.ml: derived utility operations on terms; also includes constr.ml up to some renaming, and acts as a compatibility layer, to be deprecated. git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@16462 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'kernel/sorts.ml')
-rw-r--r--kernel/sorts.ml64
1 files changed, 64 insertions, 0 deletions
diff --git a/kernel/sorts.ml b/kernel/sorts.ml
new file mode 100644
index 000000000..7ab6b553a
--- /dev/null
+++ b/kernel/sorts.ml
@@ -0,0 +1,64 @@
+(************************************************************************)
+(* v * The Coq Proof Assistant / The Coq Development Team *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
+(* \VV/ **************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(************************************************************************)
+
+open Univ
+
+type contents = Pos | Null
+
+type family = InProp | InSet | InType
+
+type t =
+ | Prop of contents (* proposition types *)
+ | Type of universe
+
+let prop = Prop Null
+let set = Prop Pos
+let type1 = Type type1_univ
+
+let compare s1 s2 =
+ if s1 == s2 then 0 else
+ match s1, s2 with
+ | Prop c1, Prop c2 ->
+ begin match c1, c2 with
+ | Pos, Pos | Null, Null -> 0
+ | Pos, Null -> -1
+ | Null, Pos -> 1
+ end
+ | Type u1, Type u2 -> Universe.compare u1 u2
+ | Prop _, Type _ -> -1
+ | Type _, Prop _ -> 1
+
+let equal s1 s2 = Int.equal (compare s1 s2) 0
+
+let is_prop = function
+| Prop Null -> true
+| _ -> false
+
+let family = function
+ | Prop Null -> InProp
+ | Prop Pos -> InSet
+ | Type _ -> InType
+
+module Hsorts =
+ Hashcons.Make(
+ struct
+ type _t = t
+ type t = _t
+ type u = universe -> universe
+ let hashcons huniv = function
+ Prop c -> Prop c
+ | Type u -> Type (huniv u)
+ let equal s1 s2 =
+ match (s1,s2) with
+ (Prop c1, Prop c2) -> c1 == c2
+ | (Type u1, Type u2) -> u1 == u2
+ |_ -> false
+ let hash = Hashtbl.hash
+ end)
+
+let hcons = Hashcons.simple_hcons Hsorts.generate hcons_univ