Quot/quotient_def.ML
changeset 884 e49c6b6f37f4
parent 869 ce5f78f0eac5
child 952 9c3b3eaecaff
--- a/Quot/quotient_def.ML	Thu Jan 14 19:03:08 2010 +0100
+++ b/Quot/quotient_def.ML	Thu Jan 14 23:17:21 2010 +0100
@@ -24,24 +24,29 @@
 end
 
 
-(** interface and syntax setup **)
+(** Interface and Syntax Setup **)
 
-(* the ML-interface takes
+(* The ML-interface for a quotient definition takes 
+   as argument:
 
-  - the mixfix annotation
-  - name and attributes
-  - the new constant as term
-  - the rhs of the definition as term
+    - the mixfix annotation
+    - name and attributes
+    - the new constant as term
+    - the rhs of the definition as term
 
-  it returns the defined constant and its definition
-  theorem; stores the data in the qconsts slot       
+   It returns the defined constant and its definition
+   theorem; stores the data in the qconsts data slot. 
+
+   Restriction: At the moment the right-hand side must
+   be a terms composed of constant. Similarly the 
+   left-hand side must be a single constant.   
 *)
 fun quotient_def mx attr lhs rhs lthy =
 let
-  val (lhs_str, lhs_ty) =
-    dest_Free lhs
-    handle TERM _ => error "The name for the new constant has to be a Free; check that it is not defined yet."
-  val qconst_bname = Binding.name lhs_str;
+  val (lhs_str, lhs_ty) = dest_Free lhs handle TERM _ => error "Constant already defined."
+  val _ = if null (strip_abs_vars rhs) then () else error "The definiens cannot be an abstraction"
+
+  val qconst_bname = Binding.name lhs_str
   val absrep_trm = absrep_fun absF lthy (fastype_of rhs, lhs_ty) $ rhs
   val prop = Logic.mk_equals (lhs, Syntax.check_term lthy absrep_trm)
   val (_, prop') = LocalDefs.cert_def lthy prop
@@ -62,6 +67,7 @@
 let
   val lhs = Syntax.read_term lthy lhs_str
   val rhs = Syntax.read_term lthy rhs_str
+  (* FIXME: Relating the reads will cause errors. *) 
 in
   quotient_def mx attr lhs rhs lthy |> snd
 end