# HG changeset patch
# User huffman
# Date 1110498232 -3600
# Node ID 2de79f49385684d70a43dd03c5d480143031252a
# Parent  a59f07556a8d80f6178ee2f6211200ddf5aca33c
domain package now permits indirect recursion with these type constructors: *, ->, ++, **, u

diff -r a59f07556a8d -r 2de79f493856 src/HOLCF/domain/extender.ML
--- a/src/HOLCF/domain/extender.ML	Thu Mar 10 20:22:45 2005 +0100
+++ b/src/HOLCF/domain/extender.ML	Fri Mar 11 00:43:52 2005 +0100
@@ -66,6 +66,7 @@
 	|   rm_sorts (Type(s,ts)) = Type(s,remove_sorts ts)
 	|   rm_sorts (TVar(s,_))  = TVar(s,[])
 	and remove_sorts l = map rm_sorts l;
+	val indirect_ok = ["*","Cfun.->","Ssum.++","Sprod.**","Up.u"]
 	fun analyse indirect (TFree(v,s))  = (case assoc_string(tvars,v) of 
 		    NONE => error ("Free type variable " ^ quote v ^ " on rhs.")
 	          | SOME sort => if eq_set_string (s,defaultS) orelse
@@ -74,7 +75,9 @@
 				 else error ("Inconsistent sort constraint" ^
 				             " for type variable " ^ quote v))
         |   analyse indirect (t as Type(s,typl)) = (case assoc_string(dtnvs,s)of
-		NONE          => Type(s,map (analyse true) typl)
+		NONE          => if exists (fn x => x = s) indirect_ok
+				 then Type(s,map (analyse false) typl)
+				 else Type(s,map (analyse true) typl)
 	      | SOME typevars => if indirect 
                            then error ("Indirect recursion of type " ^ 
 				        quote (string_of_typ sg t))