packages feed

hat (empty) → 2.7.0.0

raw patch · 248 files changed

+67694/−0 lines, 248 filesdep +basedep +bytestringdep +containerssetup-changedbinary-added

Dependencies added: base, bytestring, containers, directory, haskeline, old-locale, old-time, process, random

Files

+ Hat/Array.hs view
@@ -0,0 +1,550 @@+module Hat.Array+  (module Hat.Ix,Array(),garray,aarray,harray,glistArray,alistArray,hlistArray+    ,(!!),(+!),(*!),gbounds,abounds,hbounds,gindices,gelems,aelems,helems+    ,gassocs,aassocs,hassocs,gaccumArray,aaccumArray,haccumArray,(!//),(+//)+    ,(*//),gaccum,aaccum,haccum,gixmap,aixmap,hixmap) where++import qualified Hat.PreludeBasic +import qualified Prelude +import Hat.Hack +import qualified Hat.Hat as T +import Hat.Hat  (WrapVal(wrapVal))+import Hat.Prelude +import Hat.Ix +import Hat.List  ((!\\))++data Array a b = MkArray (T.R (T.Tuple2 a a)) (T.R (T.Fun a b))++instance T.WrapVal ((Array a b))+  where+  +  wrapVal pwrapVal (kwrapVal@(MkArray (T.R _ z1wrapVal) (T.R _ z2wrapVal))) p =+    T.R kwrapVal (T.mkValueApp2 p pwrapVal aMkArray z1wrapVal z2wrapVal)+  ++garray ::+  Ix a =>+  T.RefSrcPos ->+    T.RefExp ->+      T.R (T.Fun (T.Tuple2 a a) (T.Fun (T.List (T.Tuple2 a b)) (Array a b)))++harray ::+  Ix a =>+  (T.R (T.Tuple2 a a)) ->+    (T.R (T.List (T.Tuple2 a b))) -> T.RefExp -> T.R (Array a b)++garray parray p = T.ufun2 aarray parray p harray++harray fb fivs p =+  T.ucif p+    (T.uap1 T.mkNoSrcPos p (gand T.mkNoSrcPos p)+      (T.uap1 T.mkNoSrcPos p+        (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+          (T.ufun2 T.mkLambda T.mkNoSrcPos p+            (\ f_x f_y p ->+              T.uccase T.mkNoSrcPos p+                (let+                  v0v0v0v0v1 (T.R (T.Tuple2 fi _) _) p =+                    T.uap1 T.mkNoSrcPos p+                      (T.pa1 T.Cons T.cn1 T.mkNoSrcPos p T.aCons+                        (T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p) fb fi))+                      f_y+                  v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in+                  (v0v0v0v0v1)) f_x)) fivs) (T.fromExpList T.mkNoSrcPos p [])))+    (T.con2 T.mkNoSrcPos p MkArray aMkArray fb+      (T.ufun1 T.mkLambda T.mkNoSrcPos p+        (\ fj p ->+          T.uccase T.mkNoSrcPos p+            (let+              v18v29v23v75v1 (T.R (T.Cons fv (T.R T.List _)) _) p =+                T.projection T.mkNoSrcPos p fv+              v18v29v23v75v1 (T.R T.List _) p =+                T.uwrapForward p+                  (herror+                    (T.fromLitString T.mkNoSrcPos p+                      "Array.!: undefined array element") p)+              v18v29v23v75v1 _ p =+                T.uwrapForward p+                  (herror+                    (T.fromLitString T.mkNoSrcPos p+                      "Array.!: multiply defined array element") p) in+              (v18v29v23v75v1))+            (T.uap1 T.mkNoSrcPos p+              (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                (T.ufun2 T.mkLambda T.mkNoSrcPos p+                  (\ f_x f_y p ->+                    T.uccase T.mkNoSrcPos p+                      (let+                        v0v0v0v0v1 (T.R (T.Tuple2 fi fv) _) p =+                          T.uap1 T.mkNoSrcPos p+                            (T.uap2 T.mkNoSrcPos p+                              (Hat.Prelude.g_filter T.mkNoSrcPos p)+                              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !== p) fi fj)+                              (T.pa1 T.Cons T.cn1 T.mkNoSrcPos p T.aCons fv))+                            f_y+                        v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in+                        (v0v0v0v0v1)) f_x)) fivs)+              (T.fromExpList T.mkNoSrcPos p [])))))+    (T.uwrapForward p+      (herror+        (T.fromLitString T.mkNoSrcPos p+          "Array.array: out-of-range array association") p))++glistArray ::+  Ix a =>+  T.RefSrcPos ->+    T.RefExp -> T.R (T.Fun (T.Tuple2 a a) (T.Fun (T.List b) (Array a b)))++hlistArray ::+  Ix a =>+  (T.R (T.Tuple2 a a)) -> (T.R (T.List b)) -> T.RefExp -> T.R (Array a b)++glistArray plistArray p = T.ufun2 alistArray plistArray p hlistArray++hlistArray fb fvs p =+  T.uwrapForward p+    (harray fb+      (T.uwrapForward p+        (hzipWith+          (T.ufun2 T.mkLambda T.mkNoSrcPos p+            (\ fa fb p -> T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fa fb))+          (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p) fb) fvs p)) p)++(!!) :: Ix a => T.RefSrcPos -> T.RefExp -> T.R (T.Fun (Array a b) (T.Fun a b))++(*!) :: Ix a => (T.R (Array a b)) -> T.RefExp -> T.R (T.Fun a b)++(!!) (%!) p = T.ufun1 (+!) (%!) p (*!)++(*!) (T.R (MkArray _ ff) _) p = T.projection T.mkNoSrcPos p ff+(*!) _ p = T.fatal p++gbounds ::+  Ix a => T.RefSrcPos -> T.RefExp -> T.R (T.Fun (Array a b) (T.Tuple2 a a))++hbounds :: Ix a => (T.R (Array a b)) -> T.RefExp -> T.R (T.Tuple2 a a)++gbounds pbounds p = T.ufun1 abounds pbounds p hbounds++hbounds (T.R (MkArray fb _) _) p = T.projection T.mkNoSrcPos p fb+hbounds _ p = T.fatal p++gindices ::+  Ix a => T.RefSrcPos -> T.RefExp -> T.R (T.Fun (Array a b) (T.List a))++sindices :: Ix a => T.R (T.Fun (Array a b) (T.List a))++gindices pindices p = T.uconstUse pindices p sindices++sindices =+  T.uconstDef T.mkRoot aindices+    (\ p ->+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !. p) (grange T.mkNoSrcPos p)+        (gbounds T.mkNoSrcPos p))++gelems :: Ix a => T.RefSrcPos -> T.RefExp -> T.R (T.Fun (Array a b) (T.List b))++helems :: Ix a => (T.R (Array a b)) -> T.RefExp -> T.R (T.List b)++gelems pelems p = T.ufun1 aelems pelems p helems++helems fa p =+  T.uap1 T.mkNoSrcPos p+    (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+      (T.ufun2 T.mkLambda T.mkNoSrcPos p+        (\ f_x f_y p ->+          T.uccase T.mkNoSrcPos p+            (let+              v0v0v0v0v1 fi p =+                T.uap1 T.mkNoSrcPos p+                  (T.pa1 T.Cons T.cn1 T.mkNoSrcPos p T.aCons+                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !! p) fa fi)) f_y+              v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in (v0v0v0v0v1))+            f_x)) (T.uap1 T.mkNoSrcPos p (gindices T.mkNoSrcPos p) fa))+    (T.fromExpList T.mkNoSrcPos p [])++gassocs ::+  Ix a =>+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun (Array a b) (T.List (T.Tuple2 a b)))++hassocs :: Ix a => (T.R (Array a b)) -> T.RefExp -> T.R (T.List (T.Tuple2 a b))++gassocs passocs p = T.ufun1 aassocs passocs p hassocs++hassocs fa p =+  T.uap1 T.mkNoSrcPos p+    (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+      (T.ufun2 T.mkLambda T.mkNoSrcPos p+        (\ f_x f_y p ->+          T.uccase T.mkNoSrcPos p+            (let+              v0v0v0v0v1 fi p =+                T.uap1 T.mkNoSrcPos p+                  (T.pa1 T.Cons T.cn1 T.mkNoSrcPos p T.aCons+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fi+                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !! p) fa fi))) f_y+              v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in (v0v0v0v0v1))+            f_x)) (T.uap1 T.mkNoSrcPos p (gindices T.mkNoSrcPos p) fa))+    (T.fromExpList T.mkNoSrcPos p [])++(!//) ::+  Ix a =>+  T.RefSrcPos ->+    T.RefExp ->+      T.R (T.Fun (Array a b) (T.Fun (T.List (T.Tuple2 a b)) (Array a b)))++(*//) ::+  Ix a =>+  (T.R (Array a b)) ->+    (T.R (T.List (T.Tuple2 a b))) -> T.RefExp -> T.R (Array a b)++(!//) (%//) p = T.ufun2 (+//) (%//) p (*//)++(*//) fa fnew_ivs p =+  T.uwrapForward p+    (harray (T.uwrapForward p (hbounds fa p))+      (T.uwrapForward p (((gold_ivs T.mkNoSrcPos p) *++ fnew_ivs) p)) p)+  where+  +  gold_ivs pold_ivs p = T.uconstUse pold_ivs p sold_ivs+  +  sold_ivs =+    T.uconstDef p a47v20v47v26old_ivs+      (\ p ->+        T.uap1 T.mkNoSrcPos p+          (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+            (T.ufun2 T.mkLambda T.mkNoSrcPos p+              (\ f_x f_y p ->+                T.uccase T.mkNoSrcPos p+                  (let+                    v0v0v0v0v1 fi p =+                      T.uap1 T.mkNoSrcPos p+                        (T.uap2 T.mkNoSrcPos p+                          (Hat.Prelude.g_filter T.mkNoSrcPos p)+                          (T.uap2 T.mkNoSrcPos p (gnotElem T.mkNoSrcPos p) fi+                            (gnew_is T.mkNoSrcPos p))+                          (T.pa1 T.Cons T.cn1 T.mkNoSrcPos p T.aCons+                            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fi+                              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !! p) fa+                                fi)))) f_y+                    v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in+                    (v0v0v0v0v1)) f_x))+            (T.uap1 T.mkNoSrcPos p (gindices T.mkNoSrcPos p) fa))+          (T.fromExpList T.mkNoSrcPos p []))+  +  gnew_is pnew_is p = T.uconstUse pnew_is p snew_is+  +  snew_is =+    T.uconstDef p a49v20v49v25new_is+      (\ p ->+        T.uap1 T.mkNoSrcPos p+          (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+            (T.ufun2 T.mkLambda T.mkNoSrcPos p+              (\ f_x f_y p ->+                T.uccase T.mkNoSrcPos p+                  (let+                    v0v0v0v0v1 (T.R (T.Tuple2 fi _) _) p =+                      T.uap1 T.mkNoSrcPos p+                        (T.pa1 T.Cons T.cn1 T.mkNoSrcPos p T.aCons fi) f_y+                    v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in+                    (v0v0v0v0v1)) f_x)) fnew_ivs)+          (T.fromExpList T.mkNoSrcPos p []))+  ++gaccum ::+  Ix a =>+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.Fun b (T.Fun c b))+          (T.Fun (Array a b) (T.Fun (T.List (T.Tuple2 a c)) (Array a b))))++haccum ::+  Ix a =>+  (T.R (T.Fun b (T.Fun c b))) ->+    T.RefExp ->+      T.R (T.Fun (Array a b) (T.Fun (T.List (T.Tuple2 a c)) (Array a b)))++gaccum paccum p = T.ufun1 aaccum paccum p haccum++haccum ff p =+  T.uap1 T.mkNoSrcPos p (gfoldl T.mkNoSrcPos p)+    (T.ufun2 T.mkLambda T.mkNoSrcPos p+      (\ v53v33v53v64v1 v53v33v53v64v2 p ->+        case (v53v33v53v64v1,v53v33v53v64v2) of+          (fa,T.R (T.Tuple2 fi fv) _) ->+            T.uwrapForward p+              ((fa+                  *//+                  (T.fromExpList T.mkNoSrcPos p+                    [T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fi+                        (T.uap2 T.mkNoSrcPos p ff+                          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !! p) fa fi)+                          fv)])) p)+          _ -> T.fatal p))++gaccumArray ::+  Ix a =>+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.Fun b (T.Fun c b))+          (T.Fun b+            (T.Fun (T.Tuple2 a a) (T.Fun (T.List (T.Tuple2 a c)) (Array a b)))))++haccumArray ::+  Ix a =>+  (T.R (T.Fun b (T.Fun c b))) ->+    (T.R b) ->+      (T.R (T.Tuple2 a a)) ->+        T.RefExp -> T.R (T.Fun (T.List (T.Tuple2 a c)) (Array a b))++gaccumArray paccumArray p = T.ufun3 aaccumArray paccumArray p haccumArray++haccumArray ff fz fb p =+  T.uap2 T.mkNoSrcPos p (gaccum T.mkNoSrcPos p) ff+    (T.uwrapForward p+      (harray fb+        (T.uap1 T.mkNoSrcPos p+          (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+            (T.ufun2 T.mkLambda T.mkNoSrcPos p+              (\ f_x f_y p ->+                T.uccase T.mkNoSrcPos p+                  (let+                    v0v0v0v0v1 fi p =+                      T.uap1 T.mkNoSrcPos p+                        (T.pa1 T.Cons T.cn1 T.mkNoSrcPos p T.aCons+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fi fz)) f_y+                    v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in+                    (v0v0v0v0v1)) f_x))+            (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p) fb))+          (T.fromExpList T.mkNoSrcPos p [])) p))++gixmap ::+  (Ix a,Ix b) =>+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.Tuple2 a a)+          (T.Fun (T.Fun a b) (T.Fun (Array b c) (Array a c))))++hixmap ::+  (Ix a,Ix b) =>+  (T.R (T.Tuple2 a a)) ->+    (T.R (T.Fun a b)) -> (T.R (Array b c)) -> T.RefExp -> T.R (Array a c)++gixmap pixmap p = T.ufun3 aixmap pixmap p hixmap++hixmap fb ff fa p =+  T.uwrapForward p+    (harray fb+      (T.uap1 T.mkNoSrcPos p+        (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+          (T.ufun2 T.mkLambda T.mkNoSrcPos p+            (\ f_x f_y p ->+              T.uccase T.mkNoSrcPos p+                (let+                  v0v0v0v0v1 fi p =+                    T.uap1 T.mkNoSrcPos p+                      (T.pa1 T.Cons T.cn1 T.mkNoSrcPos p T.aCons+                        (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fi+                          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !! p) fa+                            (T.uap1 T.mkNoSrcPos p ff fi)))) f_y+                  v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in+                  (v0v0v0v0v1)) f_x))+          (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p) fb))+        (T.fromExpList T.mkNoSrcPos p [])) p)++instance Ix a => Functor ((Array a))+  where+  +  gfmap pfmap p =+    T.ufun2 a64v5v64v46fmap pfmap p hfmap+    where+    +    hfmap ffn (T.R (MkArray fb ff) _) p =+      T.con2 T.mkNoSrcPos p MkArray aMkArray fb+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !. p) ffn ff)+    hfmap _ _ p = T.fatal p+    +  ++instance (Ix a,Eq b) => Eq ((Array a b))+  where+  +  (!==) (%==) p =+    T.ufun2 (++^=^=+^=@==) (%==) p (*==)+    where+    +    (*==) fa fa' p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !== p)+        (T.uwrapForward p (hassocs fa p)) (T.uwrapForward p (hassocs fa' p))+    +  ++instance (Ix a,Ord b) => Ord ((Array a b))+  where+  +  (!<=) (%<=) p =+    T.ufun2 (+^!=^=^!=@<=) (%<=) p (*<=)+    where+    +    (*<=) fa fa' p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !<= p)+        (T.uwrapForward p (hassocs fa p)) (T.uwrapForward p (hassocs fa' p))+    +  ++instance (Ix a,Show a,Show b) => Show ((Array a b))+  where+  +  gshowsPrec pshowsPrec p =+    T.ufun2 a73v5v76v35showsPrec pshowsPrec p hshowsPrec+    where+    +    hshowsPrec fp fa p =+      T.uwrapForward p+        (hshowParen+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !> p) fp+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 9)))+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !. p)+            (T.uap1 T.mkNoSrcPos p (gshowString T.mkNoSrcPos p)+              (T.fromLitString T.mkNoSrcPos p "array "))+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !. p)+              (T.uap1 T.mkNoSrcPos p (gshows T.mkNoSrcPos p)+                (T.uwrapForward p (hbounds fa p)))+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !. p)+                (T.uap1 T.mkNoSrcPos p (gshowChar T.mkNoSrcPos p)+                  (T.conChar T.mkNoSrcPos p ' '))+                (T.uap1 T.mkNoSrcPos p (gshows T.mkNoSrcPos p)+                  (T.uwrapForward p (hassocs fa p)))))) p)+    +  ++instance (Ix a,Read a,Read b) => Read ((Array a b))+  where+  +  greadsPrec preadsPrec p =+    T.ufun1 a79v5v80v13readsPrec preadsPrec p hreadsPrec+    where+    +    hreadsPrec fp p =+      T.uwrapForward p+        (hreadParen+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !> p) fp+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 9)))+          (T.ufun1 T.mkLambda T.mkNoSrcPos p+            (\ fr p ->+              T.uap1 T.mkNoSrcPos p+                (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                  (T.ufun2 T.mkLambda T.mkNoSrcPos p+                    (\ f_x f_y p ->+                      T.uccase T.mkNoSrcPos p+                        (let+                          v0v0v0v0v1+                            (T.R+                              (T.Tuple2+                                (T.R+                                  (T.Cons (T.R 'a' _)+                                    (T.R+                                      (T.Cons (T.R 'r' _)+                                        (T.R+                                          (T.Cons (T.R 'r' _)+                                            (T.R+                                              (T.Cons (T.R 'a' _)+                                                (T.R+                                                  (T.Cons (T.R 'y' _)+                                                    (T.R T.List _)) _)) _)) _))+                                      _)) _) fs) _) p =+                            T.uap1 T.mkNoSrcPos p+                              (T.uap2 T.mkNoSrcPos p+                                (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                                (T.ufun2 T.mkLambda T.mkNoSrcPos p+                                  (\ f_x f_y p ->+                                    T.uccase T.mkNoSrcPos p+                                      (let+                                        v0v0v0v0v1 (T.R (T.Tuple2 fb ft) _) p =+                                          T.uap1 T.mkNoSrcPos p+                                            (T.uap2 T.mkNoSrcPos p+                                              (Hat.Prelude.g_foldr T.mkNoSrcPos+                                                p)+                                              (T.ufun2 T.mkLambda T.mkNoSrcPos p+                                                (\ f_x f_y p ->+                                                  T.uccase T.mkNoSrcPos p+                                                    (let+                                                      v0v0v0v0v1+                                                        (T.R (T.Tuple2 fas fu)+                                                          _) p =+                                                        T.uap1 T.mkNoSrcPos p+                                                          (T.pa1 T.Cons T.cn1+                                                            T.mkNoSrcPos p+                                                            T.aCons+                                                            (T.con2 T.mkNoSrcPos+                                                              p T.Tuple2+                                                              T.aTuple2+                                                              (T.uwrapForward p+                                                                (harray fb fas+                                                                  p)) fu)) f_y+                                                      v0v0v0v0v1 _ p =+                                                        T.projection+                                                          T.mkNoSrcPos p f_y in+                                                      (v0v0v0v0v1)) f_x))+                                              (T.uap1 T.mkNoSrcPos p+                                                (greads T.mkNoSrcPos p) ft)) f_y+                                        v0v0v0v0v1 _ p =+                                          T.projection T.mkNoSrcPos p f_y in+                                        (v0v0v0v0v1)) f_x))+                                (T.uap1 T.mkNoSrcPos p (greads T.mkNoSrcPos p)+                                  fs)) f_y+                          v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in+                          (v0v0v0v0v1)) f_x)) (T.uwrapForward p (hlex fr p)))+                (T.fromExpList T.mkNoSrcPos p []))) p)+    +  ++tArray = T.mkModule "Array" "Array.hs" Prelude.False++aMkArray = T.mkConstructor tArray 120018 120024 3 2 "MkArray"++aarray = T.mkVariable tArray 150001 240064 3 2 "array" Prelude.False++alistArray = T.mkVariable tArray 270001 270071 3 2 "listArray" Prelude.False++(+!) = T.mkVariable tArray 300002 300026 38 1 "!" Prelude.False++abounds = T.mkVariable tArray 330001 330026 3 1 "bounds" Prelude.False++aindices = T.mkVariable tArray 360001 360039 3 0 "indices" Prelude.False++aelems = T.mkVariable tArray 390001 390005 3 1 "elems" Prelude.False++aassocs = T.mkVariable tArray 420001 420006 3 1 "assocs" Prelude.False++(+//) = T.mkVariable tArray 450003 450004 38 2 "//" Prelude.False++aaccum = T.mkVariable tArray 530001 530064 3 1 "accum" Prelude.False++aaccumArray = T.mkVariable tArray 570001 570039 3 3 "accumArray" Prelude.False++aixmap = T.mkVariable tArray 610001 610029 3 3 "ixmap" Prelude.False++a64v5v64v46fmap = T.mkVariable tArray 640005 640046 3 2 "fmap" Prelude.False++(++^=^=+^=@==) = T.mkVariable tArray 670007 670008 16 2 "==" Prelude.False++(+^!=^=^!=@<=) = T.mkVariable tArray 700007 700008 16 2 "<=" Prelude.False++a73v5v76v35showsPrec =+  T.mkVariable tArray 730005 760035 3 2 "showsPrec" Prelude.False++a79v5v80v13readsPrec =+  T.mkVariable tArray 790005 800013 3 1 "readsPrec" Prelude.False++a47v20v47v26old_ivs =+  T.mkVariable tArray 470020 470026 3 0 "old_ivs" Prelude.True++a49v20v49v25new_is = T.mkVariable tArray 490020 490025 3 0 "new_is" Prelude.True
+ Hat/CPUTime.hs view
@@ -0,0 +1,34 @@+module Hat.CPUTime (ggetCPUTime,gcpuTimePrecision) where++import qualified Hat.PreludeBasic +import qualified Prelude +import Hat.Hack +import qualified Hat.Hat as T +import Hat.Hat  (WrapVal(wrapVal))+import Hat.Prelude +import Hat.PreludeBuiltinTypes +import qualified System.CPUTime as CPUTime ++ggetCPUTime :: T.RefSrcPos -> T.RefExp -> T.R (IO Integer)++ggetCPUTime pgetCPUTime p = T.uconstUse pgetCPUTime p sgetCPUTime++sgetCPUTime =+  T.uconstDef T.mkRoot agetCPUTime+    (\ p -> (T.fromIO T.fromInteger) p CPUTime.getCPUTime)++gcpuTimePrecision :: T.RefSrcPos -> T.RefExp -> T.R Integer++gcpuTimePrecision pcpuTimePrecision p =+  T.uconstUse pcpuTimePrecision p scpuTimePrecision++scpuTimePrecision =+  T.uconstDef T.mkRoot acpuTimePrecision+    (\ p -> T.fromInteger p CPUTime.cpuTimePrecision)++tCPUTime = T.mkModule "CPUTime" "CPUTime.hs" Prelude.False++agetCPUTime = T.mkVariable tCPUTime 60001 70024 3 0 "getCPUTime" Prelude.False++acpuTimePrecision =+  T.mkVariable tCPUTime 90001 100029 3 0 "cpuTimePrecision" Prelude.False
+ Hat/Char.hs view
@@ -0,0 +1,20 @@+module Hat.Char+  (gisAscii,aisAscii,hisAscii,gisLatin1,aisLatin1,hisLatin1,gisControl+    ,aisControl,hisControl,gisPrint,aisPrint,hisPrint,gisSpace,aisSpace,hisSpace+    ,gisUpper,aisUpper,hisUpper,gisLower,aisLower,hisLower,gisAlpha,aisAlpha+    ,hisAlpha,gisDigit,aisDigit,hisDigit,gisOctDigit,aisOctDigit,hisOctDigit+    ,gisHexDigit,aisHexDigit,hisHexDigit,gisAlphaNum,aisAlphaNum,hisAlphaNum+    ,gdigitToInt,adigitToInt,hdigitToInt,gintToDigit,aintToDigit,hintToDigit+    ,gtoUpper,atoUpper,htoUpper,gtoLower,atoLower,htoLower,gord,gchr+    ,greadLitChar,areadLitChar,hreadLitChar,gshowLitChar,ashowLitChar+    ,hshowLitChar,glexLitChar,alexLitChar,hlexLitChar,Char(),String()) where++import qualified Hat.PreludeBasic +import qualified Prelude +import Hat.Hack +import qualified Hat.Hat as T +import Hat.Hat  (WrapVal(wrapVal))+import Hat.Prelude +import Hat.PreludeBasic ++tChar = T.mkModule "Char" "Char.hs" Prelude.False
+ Hat/Complex.hs view
@@ -0,0 +1,1039 @@+module Hat.Complex+  (Complex((:+)),(+:+),grealPart,arealPart,hrealPart,gimagPart,aimagPart+    ,himagPart,gconjugate,aconjugate,hconjugate,gmkPolar,amkPolar,hmkPolar,gcis+    ,acis,hcis,gpolar,apolar,hpolar,gmagnitude,amagnitude,hmagnitude,gphase+    ,aphase,hphase) where++import qualified Hat.PreludeBasic +import qualified Prelude +import Hat.Hack +import qualified Hat.Hat as T +import Hat.Hat  (WrapVal(wrapVal))+import Hat.Prelude ++data Complex a = (:+) !(T.R a) !(T.R a)++instance T.WrapVal ((Complex a))+  where+  +  wrapVal pwrapVal (kwrapVal@((T.R _ z1wrapVal) :+ (T.R _ z2wrapVal))) p =+    T.R kwrapVal (T.mkValueApp2 p pwrapVal (+:+) z1wrapVal z2wrapVal)+  ++instance Eq a => Eq ((Complex a))+  where+  +  (!==) (%==) p =+    T.ufun2 (++=%@=+=%>==) (%==) p (*==)+    where+    +    (*==) (T.R (fy1 :+ fy2) _) (T.R (fy3 :+ fy4) _) p =+      T.uwrapForward p+        (((T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fy1 fy3)+            Hat.Prelude.*&&+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fy2 fy4)) p)+    (*==) _ _ p = T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse+    +  ++instance Read a => Read ((Complex a))+  where+  +  greadsPrec preadsPrec p =+    T.ufun1 a6v41v6v44readsPrec preadsPrec p hreadsPrec+    where+    +    hreadsPrec fy1 p =+      T.uwrapForward p+        (Hat.Prelude.hreadParen+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!> p) fy1+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 6)))+          (T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.gthenAp T.mkNoSrcPos p)+            (T.uwrapForward p+              (Hat.PreludeBasic.hthenLex+                (T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.gthenAp T.mkNoSrcPos p)+                  (T.uap1 T.mkNoSrcPos p+                    (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                    (T.pa0 (:+) T.cn2 T.mkNoSrcPos p (+:+)))+                  (T.uap1 T.mkNoSrcPos p (Hat.Prelude.greadsPrec T.mkNoSrcPos p)+                    (T.uap1 T.mkNoSrcPos p+                      (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                      (T.conInteger T.mkNoSrcPos p 7))))+                (T.fromLitString T.mkNoSrcPos p ":+") p))+            (T.uap1 T.mkNoSrcPos p (Hat.Prelude.greadsPrec T.mkNoSrcPos p)+              (T.uap1 T.mkNoSrcPos p+                (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                (T.conInteger T.mkNoSrcPos p 7)))) p)+    +  ++instance Show a => Show ((Complex a))+  where+  +  gshowsPrec pshowsPrec p =+    T.ufun2 a6v46v6v49showsPrec pshowsPrec p hshowsPrec+    where+    +    hshowsPrec fy1 (T.R (fy2 :+ fy3) _) p =+      T.uwrapForward p+        (Hat.Prelude.hshowParen+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!> p) fy1+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 6)))+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+              (T.uap2 T.mkNoSrcPos p (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                (T.uap1 T.mkNoSrcPos p+                  (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                  (T.conInteger T.mkNoSrcPos p 7)) fy2)+              (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+                (T.fromLitString T.mkNoSrcPos p " :+ ")))+            (T.uap2 T.mkNoSrcPos p (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+              (T.uap1 T.mkNoSrcPos p+                (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                (T.conInteger T.mkNoSrcPos p 7)) fy3)) p)+    hshowsPrec _ _ p = T.fatal p+    +  ++grealPart,gimagPart ::+  RealFloat a => T.RefSrcPos -> T.RefExp -> T.R (T.Fun (Complex a) a)++hrealPart :: RealFloat a => (T.R (Complex a)) -> T.RefExp -> T.R a++himagPart :: RealFloat a => (T.R (Complex a)) -> T.RefExp -> T.R a++grealPart prealPart p = T.ufun1 arealPart prealPart p hrealPart++hrealPart (T.R (fx :+ fy) _) p = T.projection T.mkNoSrcPos p fx+hrealPart _ p = T.fatal p++gimagPart pimagPart p = T.ufun1 aimagPart pimagPart p himagPart++himagPart (T.R (fx :+ fy) _) p = T.projection T.mkNoSrcPos p fy+himagPart _ p = T.fatal p++gconjugate ::+  RealFloat a => T.RefSrcPos -> T.RefExp -> T.R (T.Fun (Complex a) (Complex a))++hconjugate :: RealFloat a => (T.R (Complex a)) -> T.RefExp -> T.R (Complex a)++gconjugate pconjugate p = T.ufun1 aconjugate pconjugate p hconjugate++hconjugate (T.R (fx :+ fy) _) p =+  T.con2 T.mkNoSrcPos p (:+) (+:+) fx+    (T.uap1 T.mkNoSrcPos p (gnegate T.mkNoSrcPos p) fy)+hconjugate _ p = T.fatal p++gmkPolar ::+  RealFloat a => T.RefSrcPos -> T.RefExp -> T.R (T.Fun a (T.Fun a (Complex a)))++hmkPolar :: RealFloat a => (T.R a) -> (T.R a) -> T.RefExp -> T.R (Complex a)++gmkPolar pmkPolar p = T.ufun2 amkPolar pmkPolar p hmkPolar++hmkPolar fr ftheta p =+  T.con2 T.mkNoSrcPos p (:+) (+:+)+    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) fr+      (T.uap1 T.mkNoSrcPos p (gcos T.mkNoSrcPos p) ftheta))+    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) fr+      (T.uap1 T.mkNoSrcPos p (gsin T.mkNoSrcPos p) ftheta))++gcis :: RealFloat a => T.RefSrcPos -> T.RefExp -> T.R (T.Fun a (Complex a))++hcis :: RealFloat a => (T.R a) -> T.RefExp -> T.R (Complex a)++gcis pcis p = T.ufun1 acis pcis p hcis++hcis ftheta p =+  T.con2 T.mkNoSrcPos p (:+) (+:+)+    (T.uap1 T.mkNoSrcPos p (gcos T.mkNoSrcPos p) ftheta)+    (T.uap1 T.mkNoSrcPos p (gsin T.mkNoSrcPos p) ftheta)++gpolar ::+  RealFloat a =>+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun (Complex a) (T.Tuple2 a a))++hpolar :: RealFloat a => (T.R (Complex a)) -> T.RefExp -> T.R (T.Tuple2 a a)++gpolar ppolar p = T.ufun1 apolar ppolar p hpolar++hpolar fz p =+  T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 (T.uwrapForward p (hmagnitude fz p))+    (T.uwrapForward p (hphase fz p))++gmagnitude ::+  RealFloat a => T.RefSrcPos -> T.RefExp -> T.R (T.Fun (Complex a) a)++hmagnitude :: RealFloat a => (T.R (Complex a)) -> T.RefExp -> T.R a++gmagnitude pmagnitude p = T.ufun1 amagnitude pmagnitude p hmagnitude++hmagnitude (T.R (fx :+ fy) _) p =+  T.uap2 T.mkNoSrcPos p (gscaleFloat T.mkNoSrcPos p) (gk T.mkNoSrcPos p)+    (T.uap1 T.mkNoSrcPos p (gsqrt T.mkNoSrcPos p)+      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+        (T.uwrapForward p+          (((T.uap2 T.mkNoSrcPos p (gscaleFloat T.mkNoSrcPos p)+                (gmk T.mkNoSrcPos p) fx)+              *^+              (T.uap1 T.mkNoSrcPos p+                  (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                  (T.conInteger T.mkNoSrcPos p 2)+                :: T.R Integer)) p))+        (T.uwrapForward p+          (((T.uap2 T.mkNoSrcPos p (gscaleFloat T.mkNoSrcPos p)+                (gmk T.mkNoSrcPos p) fy)+              *^+              (T.uap1 T.mkNoSrcPos p+                  (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                  (T.conInteger T.mkNoSrcPos p 2)+                :: T.R Integer)) p))))+  where+  +  gk pk p = T.uconstUse pk p sk+  +  sk =+    T.uconstDef p a28v11v28v43k+      (\ p ->+        T.uap2 T.mkNoSrcPos p (gmax T.mkNoSrcPos p)+          (T.uap1 T.mkNoSrcPos p (gexponent T.mkNoSrcPos p) fx)+          (T.uap1 T.mkNoSrcPos p (gexponent T.mkNoSrcPos p) fy))+  +  gmk pmk p = T.uconstUse pmk p smk+  +  smk =+    T.uconstDef p a29v11v29v18mk+      (\ p ->+        T.uap1 T.mkNoSrcPos p (gnegate T.mkNoSrcPos p) (gk T.mkNoSrcPos p))+  +hmagnitude _ p = T.fatal p++gphase :: RealFloat a => T.RefSrcPos -> T.RefExp -> T.R (T.Fun (Complex a) a)++hphase :: RealFloat a => (T.R (Complex a)) -> T.RefExp -> T.R a++gphase pphase p = T.ufun1 aphase pphase p hphase++hphase (z1phase@(T.R (fv32v8v32v8n :+ v32v13v32v13n) _)) p =+  T.ucguard+    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv32v8v32v8n+      (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 0))) (h v32v13v32v13n p)+    (y1phase z1phase p)+  where+  +  h fv32v13v32v13n p =+    T.ucguard+      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv32v13v32v13n+        (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0))) (h p) (y1phase z1phase p)+    where+    +    h p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 0)+    h p = y1phase z1phase p+    +  h _ p = y1phase z1phase p+  +hphase z1phase p = y1phase z1phase p++y1phase (T.R (fx :+ fy) _) p =+  T.uap2 T.mkNoSrcPos p (gatan2 T.mkNoSrcPos p) fy fx+y1phase _ p = T.fatal p++instance RealFloat a => Num ((Complex a))+  where+  +  (!+) (%+) p =+    T.ufun2 (+%^=#$=%^=#$+) (%+) p (*+)+    where+    +    (*+) (T.R (fx :+ fy) _) (T.R (fx' :+ fy') _) p =+      T.con2 T.mkNoSrcPos p (:+) (+:+)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p) fx fx')+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p) fy fy')+    (*+) _ _ p = T.fatal p+    +  +  (!-) (%-) p =+    T.ufun2 (+%@=#$=%@=#$-) (%-) p (*-)+    where+    +    (*-) (T.R (fx :+ fy) _) (T.R (fx' :+ fy') _) p =+      T.con2 T.mkNoSrcPos p (:+) (+:+)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !- p) fx fx')+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !- p) fy fy')+    (*-) _ _ p = T.fatal p+    +  +  (!*) (%*) p =+    T.ufun2 (+%>=#$=%>=#$*) (%*) p (**)+    where+    +    (**) (T.R (fx :+ fy) _) (T.R (fx' :+ fy') _) p =+      T.con2 T.mkNoSrcPos p (:+) (+:+)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !- p)+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) fx fx')+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) fy fy'))+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) fx fy')+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) fy fx'))+    (**) _ _ p = T.fatal p+    +  +  gnegate pnegate p =+    T.ufun1 a40v5v40v41negate pnegate p hnegate+    where+    +    hnegate (T.R (fx :+ fy) _) p =+      T.con2 T.mkNoSrcPos p (:+) (+:+)+        (T.uap1 T.mkNoSrcPos p (gnegate T.mkNoSrcPos p) fx)+        (T.uap1 T.mkNoSrcPos p (gnegate T.mkNoSrcPos p) fy)+    hnegate _ p = T.fatal p+    +  +  gabs pabs p =+    T.ufun1 a41v5v41v29abs pabs p habs+    where+    +    habs fz p =+      T.con2 T.mkNoSrcPos p (:+) (+:+) (T.uwrapForward p (hmagnitude fz p))+        (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0))+    +  +  gsignum psignum p =+    T.ufun1 a42v5v43v56signum psignum p hsignum+    where+    +    hsignum fv42v12v42v12n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv42v12v42v12n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 0))) (h p) (y1signum fv42v12v42v12n p)+      where+      +      h p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0)+      h p = y1signum fv42v12v42v12n p+      +    hsignum fv42v12v42v12n p = y1signum fv42v12v42v12n p+    +    y1signum (fz@(T.R (fx :+ fy) _)) p =+      T.con2 T.mkNoSrcPos p (:+) (+:+)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !/ p) fx (gr T.mkNoSrcPos p))+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !/ p) fy (gr T.mkNoSrcPos p))+      where+      +      gr pr p = T.uconstUse pr p sr+      +      sr =+        T.uconstDef p a43v42v43v56r (\ p -> T.uwrapForward p (hmagnitude fz p))+      +    y1signum _ p = T.fatal p+    +  +  gfromInteger pfromInteger p =+    T.ufun1 a44v5v44v39fromInteger pfromInteger p hfromInteger+    where+    +    hfromInteger fn p =+      T.con2 T.mkNoSrcPos p (:+) (+:+)+        (T.uap1 T.mkNoSrcPos p (gfromInteger T.mkNoSrcPos p) fn)+        (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0))+    +  ++instance RealFloat a => Fractional ((Complex a))+  where+  +  (!/) (%/) p =+    T.ufun2 (+&^=#!=&^=#!/) (%/) p (*/)+    where+    +    (*/) (T.R (fx :+ fy) _) (T.R (fx' :+ fy') _) p =+      T.con2 T.mkNoSrcPos p (:+) (+:+)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !/ p)+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) fx (gx'' T.mkNoSrcPos p))+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) fy+              (gy'' T.mkNoSrcPos p))) (gd T.mkNoSrcPos p))+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !/ p)+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !- p)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) fy (gx'' T.mkNoSrcPos p))+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) fx+              (gy'' T.mkNoSrcPos p))) (gd T.mkNoSrcPos p))+      where+      +      gx'' px'' p = T.uconstUse px'' p sx''+      +      sx'' =+        T.uconstDef p a49v5v49v25x''+          (\ p ->+            T.uap2 T.mkNoSrcPos p (gscaleFloat T.mkNoSrcPos p)+              (gk T.mkNoSrcPos p) fx')+      +      gy'' py'' p = T.uconstUse py'' p sy''+      +      sy'' =+        T.uconstDef p a50v5v50v25y''+          (\ p ->+            T.uap2 T.mkNoSrcPos p (gscaleFloat T.mkNoSrcPos p)+              (gk T.mkNoSrcPos p) fy')+      +      gk pk p = T.uconstUse pk p sk+      +      sk =+        T.uconstDef p a51v5v51v42k+          (\ p ->+            T.uap1 T.mkNoSrcPos p (gnegate T.mkNoSrcPos p)+              (T.uap2 T.mkNoSrcPos p (gmax T.mkNoSrcPos p)+                (T.uap1 T.mkNoSrcPos p (gexponent T.mkNoSrcPos p) fx')+                (T.uap1 T.mkNoSrcPos p (gexponent T.mkNoSrcPos p) fy')))+      +      gd pd p = T.uconstUse pd p sd+      +      sd =+        T.uconstDef p a52v5v52v25d+          (\ p ->+            T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) fx'+                (gx'' T.mkNoSrcPos p))+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) fy'+                (gy'' T.mkNoSrcPos p)))+      +    (*/) _ _ p = T.fatal p+    +  +  gfromRational pfromRational p =+    T.ufun1 a54v3v54v39fromRational pfromRational p hfromRational+    where+    +    hfromRational fa p =+      T.con2 T.mkNoSrcPos p (:+) (+:+)+        (T.uap1 T.mkNoSrcPos p (gfromRational T.mkNoSrcPos p) fa)+        (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0))+    +  ++instance RealFloat a => Floating ((Complex a))+  where+  +  gpi ppi p = T.uconstUse ppi p spi+  +  spi =+    T.uconstDef T.mkRoot a57v5v57v29pi+      (\ p ->+        T.con2 T.mkNoSrcPos p (:+) (+:+) (gpi T.mkNoSrcPos p)+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 0)))+  +  gexp pexp p =+    T.ufun1 a58v5v59v40exp pexp p hexp+    where+    +    hexp (T.R (fx :+ fy) _) p =+      T.con2 T.mkNoSrcPos p (:+) (+:+)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) (gexpx T.mkNoSrcPos p)+          (T.uap1 T.mkNoSrcPos p (gcos T.mkNoSrcPos p) fy))+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) (gexpx T.mkNoSrcPos p)+          (T.uap1 T.mkNoSrcPos p (gsin T.mkNoSrcPos p) fy))+      where+      +      gexpx pexpx p = T.uconstUse pexpx p sexpx+      +      sexpx =+        T.uconstDef p a59v29v59v40expx+          (\ p -> T.uap1 T.mkNoSrcPos p (gexp T.mkNoSrcPos p) fx)+      +    hexp _ p = T.fatal p+    +  +  glog plog p =+    T.ufun1 a60v5v60v50log plog p hlog+    where+    +    hlog fz p =+      T.con2 T.mkNoSrcPos p (:+) (+:+)+        (T.uap1 T.mkNoSrcPos p (glog T.mkNoSrcPos p)+          (T.uwrapForward p (hmagnitude fz p))) (T.uwrapForward p (hphase fz p))+    +  +  gsqrt psqrt p =+    T.ufun1 a62v5v66v67sqrt psqrt p hsqrt+    where+    +    hsqrt fv62v10v62v10n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv62v10v62v10n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 0))) (h p) (y1sqrt fv62v10v62v10n p)+      where+      +      h p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0)+      h p = y1sqrt fv62v10v62v10n p+      +    hsqrt fv62v10v62v10n p = y1sqrt fv62v10v62v10n p+    +    y1sqrt (fz@(T.R (fx :+ fy) _)) p =+      T.con2 T.mkNoSrcPos p (:+) (+:+) (gu T.mkNoSrcPos p)+        (T.ucif p+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !< p) fy+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 0)))+          (T.uap1 T.mkNoSrcPos p (gnegate T.mkNoSrcPos p) (gv T.mkNoSrcPos p))+          (gv T.mkNoSrcPos p))+      where+      +      gu pu p = T.uconstUse pu p su+      +      gv pu p = T.uconstUse pu p sv+      +      j64v29v64v33u =+        case+          T.ucif p+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !< p) fx+              (T.uap1 T.mkNoSrcPos p+                (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                (T.conInteger T.mkNoSrcPos p 0)))+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 (gv' T.mkNoSrcPos p)+              (gu' T.mkNoSrcPos p))+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 (gu' T.mkNoSrcPos p)+              (gv' T.mkNoSrcPos p)) of+          T.R (T.Tuple2 fu fv) ku -> (ku,fu,fv)+          _ -> T.fatal p+      +      su =+        T.uconstDef p a64v30v64v30u+          (\ _ -> case j64v29v64v33u of (ku,fu,fv) -> fu)+      +      sv =+        T.uconstDef p a64v32v64v32v+          (\ _ -> case j64v29v64v33u of (ku,fu,fv) -> fv)+      +      gv' pv' p = T.uconstUse pv' p sv'+      +      sv' =+        T.uconstDef p a65v29v65v49v'+          (\ p ->+            T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !/ p)+              (T.uap1 T.mkNoSrcPos p (gabs T.mkNoSrcPos p) fy)+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) (gu' T.mkNoSrcPos p)+                (T.uap1 T.mkNoSrcPos p+                  (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                  (T.conInteger T.mkNoSrcPos p 2))))+      +      gu' pu' p = T.uconstUse pu' p su'+      +      su' =+        T.uconstDef p a66v29v66v67u'+          (\ p ->+            T.uap1 T.mkNoSrcPos p (gsqrt T.mkNoSrcPos p)+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !/ p)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                  (T.uwrapForward p (hmagnitude fz p))+                  (T.uap1 T.mkNoSrcPos p (gabs T.mkNoSrcPos p) fx))+                (T.uap1 T.mkNoSrcPos p+                  (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                  (T.conInteger T.mkNoSrcPos p 2))))+      +    y1sqrt _ p = T.fatal p+    +  +  gsin psin p =+    T.ufun1 a68v5v68v54sin psin p hsin+    where+    +    hsin (T.R (fx :+ fy) _) p =+      T.con2 T.mkNoSrcPos p (:+) (+:+)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+          (T.uap1 T.mkNoSrcPos p (gsin T.mkNoSrcPos p) fx)+          (T.uap1 T.mkNoSrcPos p (gcosh T.mkNoSrcPos p) fy))+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+          (T.uap1 T.mkNoSrcPos p (gcos T.mkNoSrcPos p) fx)+          (T.uap1 T.mkNoSrcPos p (gsinh T.mkNoSrcPos p) fy))+    hsin _ p = T.fatal p+    +  +  gcos pcos p =+    T.ufun1 a69v5v69v57cos pcos p hcos+    where+    +    hcos (T.R (fx :+ fy) _) p =+      T.con2 T.mkNoSrcPos p (:+) (+:+)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+          (T.uap1 T.mkNoSrcPos p (gcos T.mkNoSrcPos p) fx)+          (T.uap1 T.mkNoSrcPos p (gcosh T.mkNoSrcPos p) fy))+        (T.uap1 T.mkNoSrcPos p (gnegate T.mkNoSrcPos p)+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+            (T.uap1 T.mkNoSrcPos p (gsin T.mkNoSrcPos p) fx)+            (T.uap1 T.mkNoSrcPos p (gsinh T.mkNoSrcPos p) fy)))+    hcos _ p = T.fatal p+    +  +  gtan ptan p =+    T.ufun1 a70v5v74v42tan ptan p htan+    where+    +    htan (T.R (fx :+ fy) _) p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !/ p)+        (T.con2 T.mkNoSrcPos p (:+) (+:+)+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) (gsinx T.mkNoSrcPos p)+            (gcoshy T.mkNoSrcPos p))+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) (gcosx T.mkNoSrcPos p)+            (gsinhy T.mkNoSrcPos p)))+        (T.con2 T.mkNoSrcPos p (:+) (+:+)+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) (gcosx T.mkNoSrcPos p)+            (gcoshy T.mkNoSrcPos p))+          (T.uap1 T.mkNoSrcPos p (gnegate T.mkNoSrcPos p)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) (gsinx T.mkNoSrcPos p)+              (gsinhy T.mkNoSrcPos p))))+      where+      +      gsinx psinx p = T.uconstUse psinx p ssinx+      +      ssinx =+        T.uconstDef p a71v29v71v41sinx+          (\ p -> T.uap1 T.mkNoSrcPos p (gsin T.mkNoSrcPos p) fx)+      +      gcosx pcosx p = T.uconstUse pcosx p scosx+      +      scosx =+        T.uconstDef p a72v29v72v41cosx+          (\ p -> T.uap1 T.mkNoSrcPos p (gcos T.mkNoSrcPos p) fx)+      +      gsinhy psinhy p = T.uconstUse psinhy p ssinhy+      +      ssinhy =+        T.uconstDef p a73v29v73v42sinhy+          (\ p -> T.uap1 T.mkNoSrcPos p (gsinh T.mkNoSrcPos p) fy)+      +      gcoshy pcoshy p = T.uconstUse pcoshy p scoshy+      +      scoshy =+        T.uconstDef p a74v29v74v42coshy+          (\ p -> T.uap1 T.mkNoSrcPos p (gcosh T.mkNoSrcPos p) fy)+      +    htan _ p = T.fatal p+    +  +  gsinh psinh p =+    T.ufun1 a76v5v76v55sinh psinh p hsinh+    where+    +    hsinh (T.R (fx :+ fy) _) p =+      T.con2 T.mkNoSrcPos p (:+) (+:+)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+          (T.uap1 T.mkNoSrcPos p (gcos T.mkNoSrcPos p) fy)+          (T.uap1 T.mkNoSrcPos p (gsinh T.mkNoSrcPos p) fx))+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+          (T.uap1 T.mkNoSrcPos p (gsin T.mkNoSrcPos p) fy)+          (T.uap1 T.mkNoSrcPos p (gcosh T.mkNoSrcPos p) fx))+    hsinh _ p = T.fatal p+    +  +  gcosh pcosh p =+    T.ufun1 a77v5v77v54cosh pcosh p hcosh+    where+    +    hcosh (T.R (fx :+ fy) _) p =+      T.con2 T.mkNoSrcPos p (:+) (+:+)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+          (T.uap1 T.mkNoSrcPos p (gcos T.mkNoSrcPos p) fy)+          (T.uap1 T.mkNoSrcPos p (gcosh T.mkNoSrcPos p) fx))+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+          (T.uap1 T.mkNoSrcPos p (gsin T.mkNoSrcPos p) fy)+          (T.uap1 T.mkNoSrcPos p (gsinh T.mkNoSrcPos p) fx))+    hcosh _ p = T.fatal p+    +  +  gtanh ptanh p =+    T.ufun1 a78v5v82v42tanh ptanh p htanh+    where+    +    htanh (T.R (fx :+ fy) _) p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !/ p)+        (T.con2 T.mkNoSrcPos p (:+) (+:+)+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) (gcosy T.mkNoSrcPos p)+            (gsinhx T.mkNoSrcPos p))+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) (gsiny T.mkNoSrcPos p)+            (gcoshx T.mkNoSrcPos p)))+        (T.con2 T.mkNoSrcPos p (:+) (+:+)+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) (gcosy T.mkNoSrcPos p)+            (gcoshx T.mkNoSrcPos p))+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) (gsiny T.mkNoSrcPos p)+            (gsinhx T.mkNoSrcPos p)))+      where+      +      gsiny psiny p = T.uconstUse psiny p ssiny+      +      ssiny =+        T.uconstDef p a79v29v79v41siny+          (\ p -> T.uap1 T.mkNoSrcPos p (gsin T.mkNoSrcPos p) fy)+      +      gcosy pcosy p = T.uconstUse pcosy p scosy+      +      scosy =+        T.uconstDef p a80v29v80v41cosy+          (\ p -> T.uap1 T.mkNoSrcPos p (gcos T.mkNoSrcPos p) fy)+      +      gsinhx psinhx p = T.uconstUse psinhx p ssinhx+      +      ssinhx =+        T.uconstDef p a81v29v81v42sinhx+          (\ p -> T.uap1 T.mkNoSrcPos p (gsinh T.mkNoSrcPos p) fx)+      +      gcoshx pcoshx p = T.uconstUse pcoshx p scoshx+      +      scoshx =+        T.uconstDef p a82v29v82v42coshx+          (\ p -> T.uap1 T.mkNoSrcPos p (gcosh T.mkNoSrcPos p) fx)+      +    htanh _ p = T.fatal p+    +  +  gasin pasin p =+    T.ufun1 a84v5v85v70asin pasin p hasin+    where+    +    hasin (fz@(T.R (fx :+ fy) _)) p =+      T.con2 T.mkNoSrcPos p (:+) (+:+) (gy' T.mkNoSrcPos p)+        (T.uap1 T.mkNoSrcPos p (gnegate T.mkNoSrcPos p) (gx' T.mkNoSrcPos p))+      where+      +      gx' px' p = T.uconstUse px' p sx'+      +      gy' px' p = T.uconstUse px' p sy'+      +      j85v31v85v36x' =+        case+          T.uap1 T.mkNoSrcPos p (glog T.mkNoSrcPos p)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+              (T.con2 T.mkNoSrcPos p (:+) (+:+)+                (T.uap1 T.mkNoSrcPos p (gnegate T.mkNoSrcPos p) fy) fx)+              (T.uap1 T.mkNoSrcPos p (gsqrt T.mkNoSrcPos p)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !- p)+                  (T.uap1 T.mkNoSrcPos p+                    (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                    (T.conInteger T.mkNoSrcPos p 1))+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) fz fz)))) of+          T.R (fx' :+ fy') kx' -> (kx',fx',fy')+          _ -> T.fatal p+      +      sx' =+        T.uconstDef p a85v31v85v32x'+          (\ _ -> case j85v31v85v36x' of (kx',fx',fy') -> fx')+      +      sy' =+        T.uconstDef p a85v35v85v36y'+          (\ _ -> case j85v31v85v36x' of (kx',fx',fy') -> fy')+      +    hasin _ p = T.fatal p+    +  +  gacos pacos p =+    T.ufun1 a86v5v88v54acos pacos p hacos+    where+    +    hacos (fz@(T.R (fx :+ fy) _)) p =+      T.con2 T.mkNoSrcPos p (:+) (+:+) (gy'' T.mkNoSrcPos p)+        (T.uap1 T.mkNoSrcPos p (gnegate T.mkNoSrcPos p) (gx'' T.mkNoSrcPos p))+      where+      +      gx'' px'' p = T.uconstUse px'' p sx''+      +      gy'' px'' p = T.uconstUse px'' p sy''+      +      j87v30v87v37x'' =+        case+          T.uap1 T.mkNoSrcPos p (glog T.mkNoSrcPos p)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p) fz+              (T.con2 T.mkNoSrcPos p (:+) (+:+)+                (T.uap1 T.mkNoSrcPos p (gnegate T.mkNoSrcPos p)+                  (gy' T.mkNoSrcPos p)) (gx' T.mkNoSrcPos p))) of+          T.R (fx'' :+ fy'') kx'' -> (kx'',fx'',fy'')+          _ -> T.fatal p+      +      sx'' =+        T.uconstDef p a87v30v87v32x''+          (\ _ -> case j87v30v87v37x'' of (kx'',fx'',fy'') -> fx'')+      +      sy'' =+        T.uconstDef p a87v35v87v37y''+          (\ _ -> case j87v30v87v37x'' of (kx'',fx'',fy'') -> fy'')+      +      gx' px' p = T.uconstUse px' p sx'+      +      gy' px' p = T.uconstUse px' p sy'+      +      j88v30v88v35x' =+        case+          T.uap1 T.mkNoSrcPos p (gsqrt T.mkNoSrcPos p)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !- p)+              (T.uap1 T.mkNoSrcPos p+                (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                (T.conInteger T.mkNoSrcPos p 1))+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) fz fz)) of+          T.R (fx' :+ fy') kx' -> (kx',fx',fy')+          _ -> T.fatal p+      +      sx' =+        T.uconstDef p a88v30v88v31x'+          (\ _ -> case j88v30v88v35x' of (kx',fx',fy') -> fx')+      +      sy' =+        T.uconstDef p a88v34v88v35y'+          (\ _ -> case j88v30v88v35x' of (kx',fx',fy') -> fy')+      +    hacos _ p = T.fatal p+    +  +  gatan patan p =+    T.ufun1 a89v5v90v68atan patan p hatan+    where+    +    hatan (fz@(T.R (fx :+ fy) _)) p =+      T.con2 T.mkNoSrcPos p (:+) (+:+) (gy' T.mkNoSrcPos p)+        (T.uap1 T.mkNoSrcPos p (gnegate T.mkNoSrcPos p) (gx' T.mkNoSrcPos p))+      where+      +      gx' px' p = T.uconstUse px' p sx'+      +      gy' px' p = T.uconstUse px' p sy'+      +      j90v30v90v35x' =+        case+          T.uap1 T.mkNoSrcPos p (glog T.mkNoSrcPos p)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !/ p)+              (T.con2 T.mkNoSrcPos p (:+) (+:+)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !- p)+                  (T.uap1 T.mkNoSrcPos p+                    (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                    (T.conInteger T.mkNoSrcPos p 1)) fy) fx)+              (T.uap1 T.mkNoSrcPos p (gsqrt T.mkNoSrcPos p)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                  (T.uap1 T.mkNoSrcPos p+                    (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                    (T.conInteger T.mkNoSrcPos p 1))+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) fz fz)))) of+          T.R (fx' :+ fy') kx' -> (kx',fx',fy')+          _ -> T.fatal p+      +      sx' =+        T.uconstDef p a90v30v90v31x'+          (\ _ -> case j90v30v90v35x' of (kx',fx',fy') -> fx')+      +      sy' =+        T.uconstDef p a90v34v90v35y'+          (\ _ -> case j90v30v90v35x' of (kx',fx',fy') -> fy')+      +    hatan _ p = T.fatal p+    +  +  gasinh pasinh p =+    T.ufun1 a92v5v92v42asinh pasinh p hasinh+    where+    +    hasinh fz p =+      T.uap1 T.mkNoSrcPos p (glog T.mkNoSrcPos p)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p) fz+          (T.uap1 T.mkNoSrcPos p (gsqrt T.mkNoSrcPos p)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+              (T.uap1 T.mkNoSrcPos p+                (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                (T.conInteger T.mkNoSrcPos p 1))+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) fz fz))))+    +  +  gacosh pacosh p =+    T.ufun1 a93v5v93v55acosh pacosh p hacosh+    where+    +    hacosh fz p =+      T.uap1 T.mkNoSrcPos p (glog T.mkNoSrcPos p)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p) fz+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p) fz+              (T.uap1 T.mkNoSrcPos p+                (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                (T.conInteger T.mkNoSrcPos p 1)))+            (T.uap1 T.mkNoSrcPos p (gsqrt T.mkNoSrcPos p)+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !/ p)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !- p) fz+                  (T.uap1 T.mkNoSrcPos p+                    (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                    (T.conInteger T.mkNoSrcPos p 1)))+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p) fz+                  (T.uap1 T.mkNoSrcPos p+                    (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                    (T.conInteger T.mkNoSrcPos p 1)))))))+    +  +  gatanh patanh p =+    T.ufun1 a94v5v94v46atanh patanh p hatanh+    where+    +    hatanh fz p =+      T.uap1 T.mkNoSrcPos p (glog T.mkNoSrcPos p)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !/ p)+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 1)) fz)+          (T.uap1 T.mkNoSrcPos p (gsqrt T.mkNoSrcPos p)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !- p)+              (T.uap1 T.mkNoSrcPos p+                (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                (T.conInteger T.mkNoSrcPos p 1))+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) fz fz))))+    +  ++tComplex = T.mkModule "Complex" "Complex.hs" Prelude.False++(+:+) = T.mkConstructor tComplex 60021 60022 24 2 ":+"++arealPart = T.mkVariable tComplex 100001 100021 3 1 "realPart" Prelude.False++aimagPart = T.mkVariable tComplex 110001 110021 3 1 "imagPart" Prelude.False++aconjugate = T.mkVariable tComplex 140001 140028 3 1 "conjugate" Prelude.False++amkPolar = T.mkVariable tComplex 170001 170050 3 2 "mkPolar" Prelude.False++acis = T.mkVariable tComplex 200001 200036 3 1 "cis" Prelude.False++apolar = T.mkVariable tComplex 230001 230034 3 1 "polar" Prelude.False++amagnitude = T.mkVariable tComplex 260001 290018 3 1 "magnitude" Prelude.False++aphase = T.mkVariable tComplex 320001 330026 3 1 "phase" Prelude.False++(++=%@=+=%>==) = T.mkVariable tComplex 60038 60039 3 2 "==" Prelude.False++a6v41v6v44readsPrec =+  T.mkVariable tComplex 60041 60044 3 1 "readsPrec" Prelude.False++a6v46v6v49showsPrec =+  T.mkVariable tComplex 60046 60049 3 2 "showsPrec" Prelude.False++(+%^=#$=%^=#$+) = T.mkVariable tComplex 370012 370012 26 2 "+" Prelude.False++(+%@=#$=%@=#$-) = T.mkVariable tComplex 380012 380012 26 2 "-" Prelude.False++(+%>=#$=%>=#$*) = T.mkVariable tComplex 390012 390012 30 2 "*" Prelude.False++a40v5v40v41negate =+  T.mkVariable tComplex 400005 400041 3 1 "negate" Prelude.False++a41v5v41v29abs = T.mkVariable tComplex 410005 410029 3 1 "abs" Prelude.False++a42v5v43v56signum =+  T.mkVariable tComplex 420005 430056 3 1 "signum" Prelude.False++a44v5v44v39fromInteger =+  T.mkVariable tComplex 440005 440039 3 1 "fromInteger" Prelude.False++(+&^=#!=&^=#!/) = T.mkVariable tComplex 470010 470010 30 2 "/" Prelude.False++a54v3v54v39fromRational =+  T.mkVariable tComplex 540003 540039 3 1 "fromRational" Prelude.False++a57v5v57v29pi = T.mkVariable tComplex 570005 570029 3 0 "pi" Prelude.False++a58v5v59v40exp = T.mkVariable tComplex 580005 590040 3 1 "exp" Prelude.False++a60v5v60v50log = T.mkVariable tComplex 600005 600050 3 1 "log" Prelude.False++a62v5v66v67sqrt = T.mkVariable tComplex 620005 660067 3 1 "sqrt" Prelude.False++a68v5v68v54sin = T.mkVariable tComplex 680005 680054 3 1 "sin" Prelude.False++a69v5v69v57cos = T.mkVariable tComplex 690005 690057 3 1 "cos" Prelude.False++a70v5v74v42tan = T.mkVariable tComplex 700005 740042 3 1 "tan" Prelude.False++a76v5v76v55sinh = T.mkVariable tComplex 760005 760055 3 1 "sinh" Prelude.False++a77v5v77v54cosh = T.mkVariable tComplex 770005 770054 3 1 "cosh" Prelude.False++a78v5v82v42tanh = T.mkVariable tComplex 780005 820042 3 1 "tanh" Prelude.False++a84v5v85v70asin = T.mkVariable tComplex 840005 850070 3 1 "asin" Prelude.False++a86v5v88v54acos = T.mkVariable tComplex 860005 880054 3 1 "acos" Prelude.False++a89v5v90v68atan = T.mkVariable tComplex 890005 900068 3 1 "atan" Prelude.False++a92v5v92v42asinh = T.mkVariable tComplex 920005 920042 3 1 "asinh" Prelude.False++a93v5v93v55acosh = T.mkVariable tComplex 930005 930055 3 1 "acosh" Prelude.False++a94v5v94v46atanh = T.mkVariable tComplex 940005 940046 3 1 "atanh" Prelude.False++a28v11v28v43k = T.mkVariable tComplex 280011 280043 3 0 "k" Prelude.True++a29v11v29v18mk = T.mkVariable tComplex 290011 290018 3 0 "mk" Prelude.True++a43v42v43v56r = T.mkVariable tComplex 430042 430056 3 0 "r" Prelude.True++a49v5v49v25x'' = T.mkVariable tComplex 490005 490025 3 0 "x''" Prelude.True++a50v5v50v25y'' = T.mkVariable tComplex 500005 500025 3 0 "y''" Prelude.True++a51v5v51v42k = T.mkVariable tComplex 510005 510042 3 0 "k" Prelude.True++a52v5v52v25d = T.mkVariable tComplex 520005 520025 3 0 "d" Prelude.True++a59v29v59v40expx = T.mkVariable tComplex 590029 590040 3 0 "expx" Prelude.True++a64v30v64v30u = T.mkVariable tComplex 640030 640030 3 0 "u" Prelude.True++a64v32v64v32v = T.mkVariable tComplex 640032 640032 3 0 "v" Prelude.True++a65v29v65v49v' = T.mkVariable tComplex 650029 650049 3 0 "v'" Prelude.True++a66v29v66v67u' = T.mkVariable tComplex 660029 660067 3 0 "u'" Prelude.True++a71v29v71v41sinx = T.mkVariable tComplex 710029 710041 3 0 "sinx" Prelude.True++a72v29v72v41cosx = T.mkVariable tComplex 720029 720041 3 0 "cosx" Prelude.True++a73v29v73v42sinhy = T.mkVariable tComplex 730029 730042 3 0 "sinhy" Prelude.True++a74v29v74v42coshy = T.mkVariable tComplex 740029 740042 3 0 "coshy" Prelude.True++a79v29v79v41siny = T.mkVariable tComplex 790029 790041 3 0 "siny" Prelude.True++a80v29v80v41cosy = T.mkVariable tComplex 800029 800041 3 0 "cosy" Prelude.True++a81v29v81v42sinhx = T.mkVariable tComplex 810029 810042 3 0 "sinhx" Prelude.True++a82v29v82v42coshx = T.mkVariable tComplex 820029 820042 3 0 "coshx" Prelude.True++a85v31v85v32x' = T.mkVariable tComplex 850031 850032 3 0 "x'" Prelude.True++a85v35v85v36y' = T.mkVariable tComplex 850035 850036 3 0 "y'" Prelude.True++a87v30v87v32x'' = T.mkVariable tComplex 870030 870032 3 0 "x''" Prelude.True++a87v35v87v37y'' = T.mkVariable tComplex 870035 870037 3 0 "y''" Prelude.True++a88v30v88v31x' = T.mkVariable tComplex 880030 880031 3 0 "x'" Prelude.True++a88v34v88v35y' = T.mkVariable tComplex 880034 880035 3 0 "y'" Prelude.True++a90v30v90v31x' = T.mkVariable tComplex 900030 900031 3 0 "x'" Prelude.True++a90v34v90v35y' = T.mkVariable tComplex 900034 900035 3 0 "y'" Prelude.True
+ Hat/Directory.hs view
@@ -0,0 +1,347 @@+module Hat.Directory+  (Permissions(Permissions,breadable,bwritable,bexecutable,bsearchable)+    ,greadable,gwritable,gexecutable,gsearchable,hreadable,hwritable,hexecutable+    ,hsearchable,areadable,awritable,aexecutable,asearchable,aPermissions+    ,gcreateDirectory,acreateDirectory,hcreateDirectory,gremoveDirectory+    ,aremoveDirectory,hremoveDirectory,gremoveFile,aremoveFile,hremoveFile+    ,grenameDirectory,arenameDirectory,hrenameDirectory,grenameFile,arenameFile+    ,hrenameFile,ggetDirectoryContents,agetDirectoryContents+    ,hgetDirectoryContents,ggetCurrentDirectory,gsetCurrentDirectory+    ,asetCurrentDirectory,hsetCurrentDirectory,gdoesFileExist,adoesFileExist+    ,hdoesFileExist,gdoesDirectoryExist,adoesDirectoryExist,hdoesDirectoryExist+    ,ggetPermissions,agetPermissions,hgetPermissions,gsetPermissions+    ,asetPermissions,hsetPermissions,ggetModificationTime,agetModificationTime+    ,hgetModificationTime) where++import qualified Hat.PreludeBasic +import qualified Prelude +import Hat.Hack +import qualified Hat.Hat as T +import Hat.Hat  (WrapVal(wrapVal))+import Hat.Prelude +import Hat.Time  (ClockTime())+import Hat.PreludeBuiltinTypes +import Hat.DirectoryBuiltinTypes +import Hat.DirectoryBuiltin +import Hat.TimeBuiltin +import qualified System.Directory as Directory ++instance Eq (Permissions)+  where+  +  (!==) (%==) p = T.uconstUse (%==) p (|==)+  +  (|==) =+    T.uconstDef T.mkRoot (+#@=&=#@=$+==)+      (\ p -> gprimPermissionsEq T.mkNoSrcPos p)+  ++instance Ord (Permissions)+  where+  +  gcompare pcompare p = T.uconstUse pcompare p scompare+  +  scompare =+    T.uconstDef T.mkRoot a21v3v21v34compare+      (\ p -> gprimPermissionsCompare T.mkNoSrcPos p)+  +  (!<=) (%<=) p = T.uconstUse (%<=) p (|<=)+  +  (|<=) =+    T.uconstDef T.mkRoot (+$$=&=$$=$@<=)+      (\ p -> gprimPermissionsLeEq T.mkNoSrcPos p)+  ++instance Read (Permissions)+  where+  +  greadsPrec preadsPrec p = T.uconstUse preadsPrec p sreadsPrec+  +  sreadsPrec =+    T.uconstDef T.mkRoot a25v3v25v38readsPrec+      (\ p -> gprimPermissionsReadsPrec T.mkNoSrcPos p)+  ++instance Show (Permissions)+  where+  +  gshowsPrec pshowsPrec p = T.uconstUse pshowsPrec p sshowsPrec+  +  sshowsPrec =+    T.uconstDef T.mkRoot a28v3v28v38showsPrec+      (\ p -> gprimPermissionsShowsPrec T.mkNoSrcPos p)+  ++gprimPermissionsEq ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Permissions (T.Fun Permissions Bool))++gprimPermissionsEq pprimPermissionsEq p =+  T.ufun2 aprimPermissionsEq pprimPermissionsEq p hprimPermissionsEq++hprimPermissionsEq z1primPermissionsEq z2primPermissionsEq kprimPermissionsEq =+  fromBool kprimPermissionsEq+    ((toPermissions kprimPermissionsEq z1primPermissionsEq)+      Prelude.==+      (toPermissions kprimPermissionsEq z2primPermissionsEq))++gprimPermissionsCompare ::+  T.RefSrcPos ->+    T.RefExp -> T.R (T.Fun Permissions (T.Fun Permissions Ordering))++gprimPermissionsCompare pprimPermissionsCompare p =+  T.ufun2 aprimPermissionsCompare pprimPermissionsCompare p+    hprimPermissionsCompare++hprimPermissionsCompare z1primPermissionsCompare z2primPermissionsCompare+  kprimPermissionsCompare =+  fromOrdering kprimPermissionsCompare+    (Prelude.compare+      (toPermissions kprimPermissionsCompare z1primPermissionsCompare)+      (toPermissions kprimPermissionsCompare z2primPermissionsCompare))++gprimPermissionsLeEq ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Permissions (T.Fun Permissions Bool))++gprimPermissionsLeEq pprimPermissionsLeEq p =+  T.ufun2 aprimPermissionsLeEq pprimPermissionsLeEq p hprimPermissionsLeEq++hprimPermissionsLeEq z1primPermissionsLeEq z2primPermissionsLeEq+  kprimPermissionsLeEq =+  fromBool kprimPermissionsLeEq+    ((toPermissions kprimPermissionsLeEq z1primPermissionsLeEq)+      Prelude.<=+      (toPermissions kprimPermissionsLeEq z2primPermissionsLeEq))++gprimPermissionsReadsPrec ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R (T.Fun Int (T.Fun String (T.List (T.Tuple2 Permissions String))))++gprimPermissionsReadsPrec pprimPermissionsReadsPrec p =+  T.ufun2 aprimPermissionsReadsPrec pprimPermissionsReadsPrec p+    hprimPermissionsReadsPrec++hprimPermissionsReadsPrec z1primPermissionsReadsPrec z2primPermissionsReadsPrec+  kprimPermissionsReadsPrec =+  (fromList (T.fromTuple2 fromPermissions fromString)) kprimPermissionsReadsPrec+    (Prelude.readsPrec+      (T.toInt kprimPermissionsReadsPrec z1primPermissionsReadsPrec)+      (toString kprimPermissionsReadsPrec z2primPermissionsReadsPrec))++gprimPermissionsShowsPrec ::+  T.RefSrcPos ->+    T.RefExp -> T.R (T.Fun Int (T.Fun Permissions (T.Fun String String)))++gprimPermissionsShowsPrec pprimPermissionsShowsPrec p =+  T.ufun3 aprimPermissionsShowsPrec pprimPermissionsShowsPrec p+    hprimPermissionsShowsPrec++hprimPermissionsShowsPrec z1primPermissionsShowsPrec z2primPermissionsShowsPrec+  z3primPermissionsShowsPrec kprimPermissionsShowsPrec =+  fromString kprimPermissionsShowsPrec+    (Prelude.showsPrec+      (T.toInt kprimPermissionsShowsPrec z1primPermissionsShowsPrec)+      (toPermissions kprimPermissionsShowsPrec z2primPermissionsShowsPrec)+      (toString kprimPermissionsShowsPrec z3primPermissionsShowsPrec))++gcreateDirectory :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun String (IO T.Tuple0))++gcreateDirectory pcreateDirectory p =+  T.ufun1 acreateDirectory pcreateDirectory p hcreateDirectory++hcreateDirectory z1createDirectory kcreateDirectory =+  (T.fromIO T.fromTuple0) kcreateDirectory+    (Directory.createDirectory (toString kcreateDirectory z1createDirectory))++gremoveDirectory :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun String (IO T.Tuple0))++gremoveDirectory premoveDirectory p =+  T.ufun1 aremoveDirectory premoveDirectory p hremoveDirectory++hremoveDirectory z1removeDirectory kremoveDirectory =+  (T.fromIO T.fromTuple0) kremoveDirectory+    (Directory.removeDirectory (toString kremoveDirectory z1removeDirectory))++gremoveFile :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun String (IO T.Tuple0))++gremoveFile premoveFile p = T.ufun1 aremoveFile premoveFile p hremoveFile++hremoveFile z1removeFile kremoveFile =+  (T.fromIO T.fromTuple0) kremoveFile+    (Directory.removeFile (toString kremoveFile z1removeFile))++grenameDirectory ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun String (T.Fun String (IO T.Tuple0)))++grenameDirectory prenameDirectory p =+  T.ufun2 arenameDirectory prenameDirectory p hrenameDirectory++hrenameDirectory z1renameDirectory z2renameDirectory krenameDirectory =+  (T.fromIO T.fromTuple0) krenameDirectory+    (Directory.renameDirectory (toString krenameDirectory z1renameDirectory)+      (toString krenameDirectory z2renameDirectory))++grenameFile ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun String (T.Fun String (IO T.Tuple0)))++grenameFile prenameFile p = T.ufun2 arenameFile prenameFile p hrenameFile++hrenameFile z1renameFile z2renameFile krenameFile =+  (T.fromIO T.fromTuple0) krenameFile+    (Directory.renameFile (toString krenameFile z1renameFile)+      (toString krenameFile z2renameFile))++ggetDirectoryContents ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun String (IO (T.List String)))++ggetDirectoryContents pgetDirectoryContents p =+  T.ufun1 agetDirectoryContents pgetDirectoryContents p hgetDirectoryContents++hgetDirectoryContents z1getDirectoryContents kgetDirectoryContents =+  (T.fromIO (fromList fromString)) kgetDirectoryContents+    (Directory.getDirectoryContents+      (toString kgetDirectoryContents z1getDirectoryContents))++ggetCurrentDirectory :: T.RefSrcPos -> T.RefExp -> T.R (IO String)++ggetCurrentDirectory pgetCurrentDirectory p =+  T.uconstUse pgetCurrentDirectory p sgetCurrentDirectory++sgetCurrentDirectory =+  T.uconstDef T.mkRoot agetCurrentDirectory+    (\ p -> (T.fromIO fromString) p Directory.getCurrentDirectory)++gsetCurrentDirectory ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun String (IO T.Tuple0))++gsetCurrentDirectory psetCurrentDirectory p =+  T.ufun1 asetCurrentDirectory psetCurrentDirectory p hsetCurrentDirectory++hsetCurrentDirectory z1setCurrentDirectory ksetCurrentDirectory =+  (T.fromIO T.fromTuple0) ksetCurrentDirectory+    (Directory.setCurrentDirectory+      (toString ksetCurrentDirectory z1setCurrentDirectory))++gdoesFileExist :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun String (IO Bool))++gdoesFileExist pdoesFileExist p =+  T.ufun1 adoesFileExist pdoesFileExist p hdoesFileExist++hdoesFileExist z1doesFileExist kdoesFileExist =+  (T.fromIO fromBool) kdoesFileExist+    (Directory.doesFileExist (toString kdoesFileExist z1doesFileExist))++gdoesDirectoryExist :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun String (IO Bool))++gdoesDirectoryExist pdoesDirectoryExist p =+  T.ufun1 adoesDirectoryExist pdoesDirectoryExist p hdoesDirectoryExist++hdoesDirectoryExist z1doesDirectoryExist kdoesDirectoryExist =+  (T.fromIO fromBool) kdoesDirectoryExist+    (Directory.doesDirectoryExist+      (toString kdoesDirectoryExist z1doesDirectoryExist))++ggetPermissions ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun String (IO Permissions))++ggetPermissions pgetPermissions p =+  T.ufun1 agetPermissions pgetPermissions p hgetPermissions++hgetPermissions z1getPermissions kgetPermissions =+  (T.fromIO fromPermissions) kgetPermissions+    (Directory.getPermissions (toString kgetPermissions z1getPermissions))++gsetPermissions ::+  T.RefSrcPos ->+    T.RefExp -> T.R (T.Fun String (T.Fun Permissions (IO T.Tuple0)))++gsetPermissions psetPermissions p =+  T.ufun2 asetPermissions psetPermissions p hsetPermissions++hsetPermissions z1setPermissions z2setPermissions ksetPermissions =+  (T.fromIO T.fromTuple0) ksetPermissions+    (Directory.setPermissions (toString ksetPermissions z1setPermissions)+      (toPermissions ksetPermissions z2setPermissions))++ggetModificationTime ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun String (IO ClockTime))++ggetModificationTime pgetModificationTime p =+  T.ufun1 agetModificationTime pgetModificationTime p hgetModificationTime++hgetModificationTime z1getModificationTime kgetModificationTime =+  (T.fromIO fromClockTime) kgetModificationTime+    (Directory.getModificationTime+      (toString kgetModificationTime z1getModificationTime))++tDirectory = T.mkModule "Directory" "Directory.hs" Prelude.False++aprimPermissionsEq =+  T.mkVariable tDirectory 300001 310056 3 2 "primPermissionsEq" Prelude.False++aprimPermissionsCompare =+  T.mkVariable tDirectory 330001 340065 3 2 "primPermissionsCompare"+    Prelude.False++aprimPermissionsLeEq =+  T.mkVariable tDirectory 360001 370058 3 2 "primPermissionsLeEq" Prelude.False++aprimPermissionsReadsPrec =+  T.mkVariable tDirectory 390001 400047 3 2 "primPermissionsReadsPrec"+    Prelude.False++aprimPermissionsShowsPrec =+  T.mkVariable tDirectory 420001 430067 3 3 "primPermissionsShowsPrec"+    Prelude.False++acreateDirectory =+  T.mkVariable tDirectory 460001 470033 3 1 "createDirectory" Prelude.False++aremoveDirectory =+  T.mkVariable tDirectory 480001 490033 3 1 "removeDirectory" Prelude.False++aremoveFile =+  T.mkVariable tDirectory 500001 510028 3 1 "removeFile" Prelude.False++arenameDirectory =+  T.mkVariable tDirectory 520001 530043 3 2 "renameDirectory" Prelude.False++arenameFile =+  T.mkVariable tDirectory 540001 550038 3 2 "renameFile" Prelude.False++agetDirectoryContents =+  T.mkVariable tDirectory 570001 580038 3 1 "getDirectoryContents" Prelude.False++agetCurrentDirectory =+  T.mkVariable tDirectory 590001 600027 3 0 "getCurrentDirectory" Prelude.False++asetCurrentDirectory =+  T.mkVariable tDirectory 610001 620037 3 1 "setCurrentDirectory" Prelude.False++adoesFileExist =+  T.mkVariable tDirectory 640001 650030 3 1 "doesFileExist" Prelude.False++adoesDirectoryExist =+  T.mkVariable tDirectory 660001 670035 3 1 "doesDirectoryExist" Prelude.False++agetPermissions =+  T.mkVariable tDirectory 690001 700031 3 1 "getPermissions" Prelude.False++asetPermissions =+  T.mkVariable tDirectory 710001 720046 3 2 "setPermissions" Prelude.False++agetModificationTime =+  T.mkVariable tDirectory 740001 750036 3 1 "getModificationTime" Prelude.False++(+#@=&=#@=$+==) = T.mkVariable tDirectory 180004 180026 16 0 "==" Prelude.False++a21v3v21v34compare =+  T.mkVariable tDirectory 210003 210034 3 0 "compare" Prelude.False++(+$$=&=$$=$@<=) = T.mkVariable tDirectory 220004 220028 16 0 "<=" Prelude.False++a25v3v25v38readsPrec =+  T.mkVariable tDirectory 250003 250038 3 0 "readsPrec" Prelude.False++a28v3v28v38showsPrec =+  T.mkVariable tDirectory 280003 280038 3 0 "showsPrec" Prelude.False
+ Hat/DirectoryBuiltin.hs view
@@ -0,0 +1,23 @@+module Hat.DirectoryBuiltin where++import Hat.Hat as T+import Hat.PreludeBuiltinTypes+import Hat.DirectoryBuiltinTypes+import qualified System.Directory as Directory++toPermissions :: RefExp -> R Permissions -> Directory.Permissions+toPermissions h +  (R (Permissions preadable pwritable pexecutable psearchable) _) =+    Directory.setOwnerReadable (toBool h preadable) $+    Directory.setOwnerWritable (toBool h pwritable) $+    Directory.setOwnerExecutable (toBool h pexecutable) $+    Directory.setOwnerSearchable (toBool h psearchable) $ +    Directory.emptyPermissions++fromPermissions :: RefExp -> Directory.Permissions -> R Permissions+fromPermissions h permission =+    con4 mkNoSrcPos h Permissions aPermissions +      (T.wrapForward h (fromBool h (Directory.readable permission))) +      (T.wrapForward h (fromBool h (Directory.writable permission)))+      (T.wrapForward h (fromBool h (Directory.executable permission))) +      (T.wrapForward h (fromBool h (Directory.searchable permission)))
+ Hat/DirectoryBuiltinTypes.hs view
@@ -0,0 +1,64 @@+module Hat.DirectoryBuiltinTypes+  (Permissions(..),greadable,hreadable,gwritable,hwritable,gexecutable+    ,hexecutable,gsearchable,hsearchable,aPermissions,areadable,awritable+    ,aexecutable,asearchable) where++import qualified Hat.PreludeBasic +import qualified Prelude +import Hat.Hack +import qualified Hat.Hat as T +import Hat.Hat  (WrapVal(wrapVal))+import Hat.Prelude ++data Permissions =+  Permissions {breadable,bwritable,bexecutable,bsearchable :: T.R Bool}++instance T.WrapVal (Permissions)+  where+  +  wrapVal pwrapVal+    (kwrapVal@(Permissions (T.R _ z1wrapVal) (T.R _ z2wrapVal) (T.R _ z3wrapVal)+        (T.R _ z4wrapVal))) p =+    T.R kwrapVal+      (T.mkValueApp4 p pwrapVal aPermissions z1wrapVal z2wrapVal z3wrapVal+        z4wrapVal)+  ++greadable preadable p = T.ufun1 areadable preadable p hreadable++hreadable (T.R z1readable _) p =+  T.projection T.mkNoSrcPos p (breadable z1readable)++gwritable pwritable p = T.ufun1 awritable pwritable p hwritable++hwritable (T.R z1writable _) p =+  T.projection T.mkNoSrcPos p (bwritable z1writable)++gexecutable pexecutable p = T.ufun1 aexecutable pexecutable p hexecutable++hexecutable (T.R z1executable _) p =+  T.projection T.mkNoSrcPos p (bexecutable z1executable)++gsearchable psearchable p = T.ufun1 asearchable psearchable p hsearchable++hsearchable (T.R z1searchable _) p =+  T.projection T.mkNoSrcPos p (bsearchable z1searchable)++tDirectoryBuiltinTypes =+  T.mkModule "DirectoryBuiltinTypes" "DirectoryBuiltinTypes.hs" Prelude.False++aPermissions =+  T.mkConstructorWFields tDirectoryBuiltinTypes 30020 30030 3 4 "Permissions"+    (areadable : (awritable : (aexecutable : (asearchable : []))))++areadable =+  T.mkVariable tDirectoryBuiltinTypes 40002 40009 3 1 "readable" Prelude.False++awritable =+  T.mkVariable tDirectoryBuiltinTypes 40014 40021 3 1 "writable" Prelude.False++aexecutable =+  T.mkVariable tDirectoryBuiltinTypes 50002 50011 3 1 "executable" Prelude.False++asearchable =+  T.mkVariable tDirectoryBuiltinTypes 50014 50023 3 1 "searchable" Prelude.False
+ Hat/Hack.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE CPP #-}+module Hat.Hack+  (+#if defined(__GLASGOW_HASKELL__) && ( __GLASGOW_HASKELL__ >= 600 )+#else+    []((:),[])+#endif+  ) where++#if defined(__GLASGOW_HASKELL__) && ( __GLASGOW_HASKELL__ >= 600 )+#else+import Prelude+#endif
+ Hat/Hat.hs view
@@ -0,0 +1,2448 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS -#include "hat-c.h" #-}+-- ----------------------------------------------------------------------------+-- Library used by all programs transformed for tracing by Hat.+-- Combinators in Haskell and interfaces to C-functions.++module Hat.Hat+  (RefModule,RefSrcPos,RefExp,RefAtom+  ,Loc,Fixity,Arity+  ,R(R)+  ,tPrelude+  ,toId,fromId+  ,Char,Int,Integer,Float,Double+  ,toChar,fromChar,toInt,fromInt,toInteger,fromInteger,toFloat,fromFloat+  ,toDouble,fromDouble+  ,Fun(Fun),IO,toIO,fromIO+  ,Tuple0(Tuple0),aTuple0,Tuple2(Tuple2),aTuple2,Tuple3(Tuple3),aTuple3+  ,Tuple4(Tuple4),aTuple4,Tuple5(Tuple5),aTuple5,Tuple6(Tuple6),aTuple6+  ,Tuple7(Tuple7),aTuple7,Tuple8(Tuple8),aTuple8,Tuple9(Tuple9),aTuple9+  ,Tuple10(Tuple10),aTuple10,Tuple11(Tuple11),aTuple11+  ,Tuple12(Tuple12),aTuple12,Tuple13(Tuple13),aTuple13+  ,Tuple14(Tuple14),aTuple14,Tuple15(Tuple15),aTuple15+  ,toTuple0,fromTuple0,toTuple2,fromTuple2+  ,List(Cons,List),aCons,aList+  ,ap1,ap2,ap3,ap4,ap5,ap6,ap7,ap8,ap9,ap10,ap11,ap12,ap13,ap14,ap15+  ,fun1,fun2,fun3,fun4,fun5,fun6,fun7,fun8,fun9,fun10,fun11,fun12,fun13,fun14+  ,fun15+  ,uap1,uap2,uap3,uap4,uap5,uap6,uap7,uap8+  ,ufun1,ufun2,ufun3,ufun4,ufun5,ufun6,ufun7,ufun8+  ,app1,app2,app3,app4,app5,uapp1,uapp2,uapp3,uapp4,uapp5,uwrapForward+  ,con0,con1,con2,con3,con4,con5,con6,con7,con8,con9,con10,con11,con12,con13+  ,con14,con15,pa0,pa1,pa2,pa3,pa4,pa5,pa6,pa7,pa8+  ,cn1,cn2,cn3,cn4,cn5,cn6,cn7,cn8,cn9,cn10,cn11,cn12+  ,cguard,ucguard,cif,ucif,ccase,uccase+  ,constUse,uconstUse,constDef,uconstDef+  ,projection+  ,WrapVal(wrapVal),update1,update2,uupdate+  ,conChar,conInteger,mkAtomRational+  ,fromExpList,fromLitString+  ,traceIO,hatError,fatal,outputTrace+  ,wrapForward+  ,mkModule,mkSrcPos,mkNoSrcPos+  ,mkRoot,mkValueUse+  ,mkValueApp1,mkValueApp2,mkValueApp3,mkValueApp4,mkValueApp5,mkValueApp6+  ,mkValueApp7,mkValueApp8,mkValueApp9,mkValueApp10,mkValueApp11,mkValueApp12+  ,mkValueApp13,mkValueApp14,mkValueApp15+  ,mkApp1,mkApp2,mkApp3,mkApp4,mkApp5,mkApp6,mkApp7,mkApp8,mkApp9,mkApp10+  ,mkApp11,mkApp12,mkApp13,mkApp14,mkApp15+  ,mkLambda,mkVariable,mkConstructor,mkConstructorWFields,mkAbstract+  ,mkDoLambda+  ) where++-- hack for only compiler currently supported:+-- #define __GLASGOW_HASKELL__ 700++import Prelude hiding (IO,fromInteger,toInteger,catch)+import qualified Prelude (IO,fromInteger,toInteger)+import qualified System.IO.Error (ioeGetErrorString)+import Data.Ratio (numerator,denominator)+import System.IO.Unsafe (unsafePerformIO)+import Data.IORef (IORef,newIORef,readIORef,writeIORef)+import Foreign.Ptr(Ptr,castPtr)+import Foreign.Marshal.Array (withArray)+import Foreign.C.String(CString,withCString)+import Control.Exception(Exception,SomeException,catch)+-- import Control.OldException (Exception,ioErrors,catch)  -- also catches black holes++-- Haskell 2010 standard:+#define FOREIGN(x) foreign import ccall unsafe x+++-- ----------------------------------------------------------------------------+-- Types of the ART trace++newtype RefModule = RM Int+newtype RefSrcPos = RSP Int+newtype RefExp = RT Int deriving Eq -- a hidden Exp has a set bit+newtype RefAtom = RA Int++mkNoSrcPos :: RefSrcPos+mkNoSrcPos = RSP 0++type Loc = Int  -- line * 10000 + column+type Fixity = Int+type Arity = Int++-- ----------------------------------------------------------------------------+-- The wrapper type++-- Invariant: the trace argument of R is always fully evaluated.+-- Trace arguments that are passed to functions are always fully evaluated.+-- No, not for pap: pap will force evaluation immediately.+data R a = R a RefExp++-- data constructor R strict in trace argument+mkR :: a -> RefExp -> R a+mkR x t = t `seq` R x t++refExp :: R a -> RefExp+refExp (R a t) = t++forceExp :: R a -> R a+forceExp r@(R _ t) = t `seq` r++-- ----------------------------------------------------------------------------+-- transformed primitive types (undefinable and with special syntax)+-- with conversion functions++-- module name:+tPrelude = mkModule "Prelude" "Prelude.hs" False+++toId :: RefExp -> R a -> R a+toId h x = x++fromId :: RefExp -> R a -> R a+fromId h x = x++toChar :: RefExp -> R Char -> Prelude.Char +toChar p (R c _) = c++fromChar :: RefExp -> Prelude.Char -> R Char+fromChar h c = conChar mkNoSrcPos h c++toInt :: RefExp -> R Int -> Prelude.Int+toInt p (R i _) = i++fromInt :: RefExp -> Int -> R Int+fromInt p i = R i (mkInt p mkNoSrcPos i)++toInteger :: RefExp -> R Integer -> Integer+toInteger p (R i _) = i++fromInteger :: RefExp -> Integer -> R Integer+fromInteger p i = conInteger mkNoSrcPos p i++toFloat :: RefExp -> R Float -> Float+toFloat p (R f _) = f++fromFloat :: RefExp -> Float -> R Float+fromFloat p f = R f (mkFloat p mkNoSrcPos f)++toDouble :: RefExp -> R Double -> Double+toDouble p (R d _) = d++fromDouble :: RefExp -> Double -> R Double+fromDouble p d = R d (mkDouble p mkNoSrcPos d)+++newtype Fun a b = Fun (RefExp -> R a -> R b)++-- arity could be stored additionally;+-- different constructors for different arity impossible (arity type args)+-- alternative idea (more complex):+-- newtype Fun a b = Fun1 (RefExp -> R a -> R b) | Funn (R a -> R b)+-- Funn implies that 'b' is again a Fun-type.++newtype IO a = IO (Prelude.IO (R a))++toIO :: (RefExp -> R a -> b) -> RefExp -> R (IO a) -> Prelude.IO b +toIO f h (R (IO io) _) = fmap (f h) io++fromIO :: (RefExp -> a -> R b) +       -> RefExp -> Prelude.IO a -> R (IO b)+fromIO f h io = R (IO (fmap (f h) io)) (mkValueUse h mkNoSrcPos aIO)++aIO :: RefAtom+aIO = mkAbstract "IO"+++-- type constructors and data constructors need to have same name,+-- because transformation doesn't distinguish the two+data Tuple0 = Tuple0  -- () would do, but this way like other tuples  +data Tuple2 a b = Tuple2 (R a) (R b) -- not type Tuple2 a b = (R a,R b)+data Tuple3 a b c = Tuple3 (R a) (R b) (R c)+data Tuple4 a b c d = Tuple4 (R a) (R b) (R c) (R d)+data Tuple5 a b c d e = Tuple5 (R a) (R b) (R c) (R d) (R e)+data Tuple6 a b c d e f = Tuple6 (R a) (R b) (R c) (R d) (R e) (R f)+data Tuple7 a b c d e f g = Tuple7 (R a) (R b) (R c) (R d) (R e) (R f) (R g)+data Tuple8 a b c d e f g h = +  Tuple8 (R a) (R b) (R c) (R d) (R e) (R f) (R g) (R h)+data Tuple9 a b c d e f g h i = +  Tuple9 (R a) (R b) (R c) (R d) (R e) (R f) (R g) (R h) (R i)+data Tuple10 a b c d e f g h i j = +  Tuple10 (R a) (R b) (R c) (R d) (R e) (R f) (R g) (R h) (R i) (R j)+data Tuple11 a b c d e f g h i j k = +  Tuple11 (R a) (R b) (R c) (R d) (R e) (R f) (R g) (R h) (R i) (R j) (R k)+data Tuple12 a b c d e f g h i j k l = +  Tuple12 (R a) (R b) (R c) (R d) (R e) (R f) (R g) (R h) (R i) (R j) (R k) +    (R l)+data Tuple13 a b c d e f g h i j k l m = +  Tuple13 (R a) (R b) (R c) (R d) (R e) (R f) (R g) (R h) (R i) (R j) (R k) +    (R l) (R m)+data Tuple14 a b c d e f g h i j k l m n = +  Tuple14 (R a) (R b) (R c) (R d) (R e) (R f) (R g) (R h) (R i) (R j) (R k) +    (R l) (R m) (R n)+data Tuple15 a b c d e f g h i j k l m n o = +  Tuple15 (R a) (R b) (R c) (R d) (R e) (R f) (R g) (R h) (R i) (R j) (R k) +    (R l) (R m) (R n) (R o)++aTuple0 = mkConstructor tPrelude 0 0 3 0 ""+aTuple2 = mkConstructor tPrelude 0 0 3 2 "," +aTuple3 = mkConstructor tPrelude 0 0 3 3 ",,"+aTuple4 = mkConstructor tPrelude 0 0 3 4 ",,,"+aTuple5 = mkConstructor tPrelude 0 0 3 5 ",,,,"+aTuple6 = mkConstructor tPrelude 0 0 3 6 ",,,,,"+aTuple7 = mkConstructor tPrelude 0 0 3 7 ",,,,,,"+aTuple8 = mkConstructor tPrelude 0 0 3 8 ",,,,,,,"+aTuple9 = mkConstructor tPrelude 0 0 3 9 ",,,,,,,,"+aTuple10 = mkConstructor tPrelude 0 0 3 10 ",,,,,,,,,"+aTuple11 = mkConstructor tPrelude 0 0 3 11 ",,,,,,,,,,"+aTuple12 = mkConstructor tPrelude 0 0 3 12 ",,,,,,,,,,,"+aTuple13 = mkConstructor tPrelude 0 0 3 13 ",,,,,,,,,,,,"+aTuple14 = mkConstructor tPrelude 0 0 3 14 ",,,,,,,,,,,,,"+aTuple15 = mkConstructor tPrelude 0 0 3 15 ",,,,,,,,,,,,,,"++toTuple0 :: RefExp -> R Tuple0 -> ()+toTuple0 h (R Tuple0 _) = ()++fromTuple0 :: RefExp -> () -> R Tuple0+fromTuple0 t () = con0 mkNoSrcPos t Tuple0 aTuple0++toTuple2 :: (RefExp -> R a -> c) -> (RefExp -> R b -> d) +         -> RefExp -> R (Tuple2 a b) -> (c,d)+toTuple2 f g h (R (Tuple2 x y) _) = (f h x,g h y)++fromTuple2 :: (RefExp -> a -> R c) -> (RefExp -> b -> R d) +           -> RefExp -> (a,b) -> R (Tuple2 c d)+fromTuple2 f g h (x,y) = +  con2 mkNoSrcPos h Tuple2 aTuple2 +    (wrapForward h (f h x)) (wrapForward h (g h y))+++data List a = Cons (R a) (R (List a)) | List  +  -- type constructor and empty list constructor need to have same name,+  -- because transformation doesn't distinguish between the two+aCons = mkConstructor tPrelude 0 0 21 2 ":"+aList = mkConstructor tPrelude 0 0 3 0 "[]"++-- ----------------------------------------------------------------------------+-- Main combinator++traceIO :: String -> R (IO a) -> Prelude.IO ()+traceIO filename gmain = do+  openTrace filename+  catch (toIO toId mkRoot (forceExp gmain)) exceptionHandler +  closeTrace++exceptionHandler :: SomeException -> Prelude.IO a+exceptionHandler e = do+  hatAborted (show e)+  return undefined++{-+exceptionHandler :: Exception -> Prelude.IO a+exceptionHandler exception = do+  hatAborted (case ioErrors exception of+                Just ioError -> System.IO.Error.ioeGetErrorString ioError	-- exception+                Nothing -> show exception)+  return undefined+-}++hatError :: RefExp -> String -> a+hatError p msg =+  errorTraceExit msg p 1 `seq` undefined++fatal :: RefExp -> a+fatal r = hatError r "No match in pattern."+++-- ----------------------------------------------------------------------------+-- Combinators++-- helpers++-- updates result of a RefExp (except Forward)+wrapResult :: RefSrcPos -> RefExp -> R a -> R a+wrapResult sr r x =+  R (entResult r sr `seq` case x of R y ry -> resResult r ry sr `seq` y) r++wrapForward :: RefExp -> R a -> R a+wrapForward h x =+  let for = mkForward h  +  in R (entForward for h `seq` case x of R y ry -> resForward for ry `seq` y) +       for ++-- Attention: loses information if first value is demanded and then RefExp+-- Then RefExp is just the hidden exp, because writing of potentially+-- cyclic expression to trace is impossible.++{- -- looks nicer but 5% less efficient with nhc98, 25% worse with ghc.+uwrapForward :: RefExp -> R a -> R a+uwrapForward h x =+  unsafePerformIO (do+    statusRef <- newIORef (Hidden h)+    return $+      R (unsafePerformIO (do+          status <- readIORef statusRef+          case status of+            Hidden _ -> +              case x of +                R rv tv -> writeIORef statusRef Eval >> return rv+            Forward for -> +              return $ entForward for h `seq` +                         case x of +                           R y ry -> resForward for ry `seq` y))+        (unsafePerformIO (do+          status <- readIORef statusRef+          case status of+            Hidden h -> do+                          let for = mkForward h +                          writeIORef statusRef (Forward for) +                          return for+            Eval -> return h)))+-}++uwrapForward :: RefExp -> R a -> R a+uwrapForward h x =+  let status = unsafePerformIO (newIORef (Hidden h))+  in status `seq`+     R (case unsafePerformIO (readIORef status) of+          Hidden _ -> +            case x of +              R rv tv -> unsafePerformIO (writeIORef status Eval) `seq` rv+          Forward for -> entForward for h `seq` +                           case x of +                             R y ry -> resForward for ry `seq` y)+       (case unsafePerformIO (readIORef status) of+          Hidden h ->+              let for = mkForward h in+              unsafePerformIO (writeIORef status (Forward for)) `seq` for+          Eval -> {- unsafePerformIO (putStrLn "No!") `seq` -} h)++        +data Status = Hidden RefExp  -- neither value nor RefExp yet demanded+            | Forward RefExp -- RefExp demanded, value not yet+            | Eval           -- value demanded, RefExp not (yet?)     ++-- insert a hidden Exp if it is not already there (called from traced code)+hide :: RefExp -> (RefExp -> R z) -> R z+hide p f =+  if hidden p +    then f p+    else let r = mkHidden p in wrapResult mkNoSrcPos r (f r)++-- combinators for n-ary traced application.++ap1 :: RefSrcPos -> RefExp -> R (Fun a z) -> R a -> R z +ap1 sr p (R (Fun f) rf) a@(R _ ra) = +  let r = mkApp1 p sr rf ra+  in  wrapResult sr r (f r a)++ap2 :: RefSrcPos -> RefExp -> R (Fun a (Fun b z)) -> R a -> R b -> R z+ap2 sr p (R (Fun f) rf) a@(R _ ra) b@(R _ rb) = +  let r = mkApp2 p sr rf ra rb+  in  wrapResult sr r (pap1 sr p r (f r a) b)++ap3 :: RefSrcPos -> RefExp +    -> R (Fun a (Fun b (Fun c z))) -> R a -> R b -> R c -> R z+ap3 sr p (R (Fun f) rf) a@(R _ ra) b@(R _ rb) c@(R _ rc) = +  let r = mkApp3 p sr rf ra rb rc+  in  wrapResult sr r (pap2 sr p r (f r a) b c) ++ap4 :: RefSrcPos -> RefExp +    -> R (Fun a (Fun b (Fun c (Fun d z)))) -> R a -> R b -> R c -> R d -> R z+ap4 sr p (R (Fun f) rf) a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) = +  let r = mkApp4 p sr rf ra rb rc rd+  in  wrapResult sr r (pap3 sr p r (f r a) b c d)++ap5 :: RefSrcPos -> RefExp +    -> R (Fun a (Fun b (Fun c (Fun d (Fun e z))))) +    -> R a -> R b -> R c -> R d -> R e -> R z+ap5 sr p (R (Fun f) rf) a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) +  e@(R _ re) =+  let r = mkApp5 p sr rf ra rb rc rd re+  in  wrapResult sr r (pap4 sr p r (f r a) b c d e)++ap6 :: RefSrcPos -> RefExp +    -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g z)))))) +    -> R a -> R b -> R c -> R d -> R e -> R g -> R z+ap6 sr p (R (Fun f) rf) a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) e@(R _ re) +  g@(R _ rg) =+  let r = mkApp6 p sr rf ra rb rc rd re rg+  in  wrapResult sr r (pap5 sr p r (f r a) b c d e g)++ap7 :: RefSrcPos -> RefExp +    -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h z)))))))+    -> R a -> R b -> R c -> R d -> R e -> R g -> R h -> R z+ap7 sr p (R (Fun f) rf) a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) e@(R _ re) +  g@(R _ rg) h@(R _ rh) =+  let r = mkApp7 p sr rf ra rb rc rd re rg rh+  in  wrapResult sr r (pap6 sr p r (f r a) b c d e g h)++ap8 :: RefSrcPos -> RefExp +    -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i z)))))))) +    -> R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> R z+ap8 sr p (R (Fun f) rf) a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) e@(R _ re) +  g@(R _ rg) h@(R _ rh) i@(R _ ri) =+  let r = mkApp8 p sr rf ra rb rc rd re rg rh ri+  in  wrapResult sr r (pap7 sr p r (f r a) b c d e g h i)++ap9 :: RefSrcPos -> RefExp +    -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i +         (Fun j z)))))))))+    -> R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> R j -> R z+ap9 sr p (R (Fun f) rf) a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) e@(R _ re) +  g@(R _ rg) h@(R _ rh) i@(R _ ri) j@(R _ rj) =+  let r = mkApp9 p sr rf ra rb rc rd re rg rh ri rj+  in  wrapResult sr r (pap8 sr p r (f r a) b c d e g h i j)++ap10 :: RefSrcPos -> RefExp +    -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i +         (Fun j (Fun k z))))))))))+    -> R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> R j -> R k +    -> R z+ap10 sr p (R (Fun f) rf) a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) +  e@(R _ re) g@(R _ rg) h@(R _ rh) i@(R _ ri) j@(R _ rj) k@(R _ rk) =+  let r = mkApp10 p sr rf ra rb rc rd re rg rh ri rj rk+  in  wrapResult sr r (pap9 sr p r (f r a) b c d e g h i j k)++ap11 :: RefSrcPos -> RefExp +    -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i +         (Fun j (Fun k (Fun l z)))))))))))+    -> R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> R j -> R k +    -> R l -> R z+ap11 sr p (R (Fun f) rf) a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) +  e@(R _ re) g@(R _ rg) h@(R _ rh) i@(R _ ri) j@(R _ rj) k@(R _ rk) +  l@(R _ rl) =+  let r = mkApp11 p sr rf ra rb rc rd re rg rh ri rj rk rl+  in  wrapResult sr r (pap10 sr p r (f r a) b c d e g h i j k l)++ap12 :: RefSrcPos -> RefExp +    -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i +         (Fun j (Fun k (Fun l (Fun m z))))))))))))+    -> R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> R j -> R k +    -> R l -> R m -> R z+ap12 sr p (R (Fun f) rf) a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) +  e@(R _ re) g@(R _ rg) h@(R _ rh) i@(R _ ri) j@(R _ rj) k@(R _ rk) +  l@(R _ rl) m@(R _ rm) =+  let r = mkApp12 p sr rf ra rb rc rd re rg rh ri rj rk rl rm+  in  wrapResult sr r (pap11 sr p r (f r a) b c d e g h i j k l m)++ap13 :: RefSrcPos -> RefExp +    -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i +         (Fun j (Fun k (Fun l (Fun m (Fun n z)))))))))))))+    -> R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> R j -> R k +    -> R l -> R m -> R n -> R z+ap13 sr p (R (Fun f) rf) a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) +  e@(R _ re) g@(R _ rg) h@(R _ rh) i@(R _ ri) j@(R _ rj) k@(R _ rk) +  l@(R _ rl) m@(R _ rm) n@(R _ rn) =+  let r = mkApp13 p sr rf ra rb rc rd re rg rh ri rj rk rl rm rn+  in  wrapResult sr r (pap12 sr p r (f r a) b c d e g h i j k l m n)++ap14 :: RefSrcPos -> RefExp +    -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i +         (Fun j (Fun k (Fun l (Fun m (Fun n (Fun o z))))))))))))))+    -> R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> R j -> R k +    -> R l -> R m -> R n -> R o -> R z+ap14 sr p (R (Fun f) rf) a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) +  e@(R _ re) g@(R _ rg) h@(R _ rh) i@(R _ ri) j@(R _ rj) k@(R _ rk) +  l@(R _ rl) m@(R _ rm) n@(R _ rn) o@(R _ ro) =+  let r = mkApp14 p sr rf ra rb rc rd re rg rh ri rj rk rl rm rn ro+  in  wrapResult sr r (pap13 sr p r (f r a) b c d e g h i j k l m n o)++ap15 :: RefSrcPos -> RefExp +    -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i +         (Fun j (Fun k (Fun l (Fun m (Fun n (Fun o (Fun q z)))))))))))))))+    -> R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> R j -> R k +    -> R l -> R m -> R n -> R o -> R q -> R z+ap15 sr p (R (Fun f) rf) a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) +  e@(R _ re) g@(R _ rg) h@(R _ rh) i@(R _ ri) j@(R _ rj) k@(R _ rk) +  l@(R _ rl) m@(R _ rm) n@(R _ rn) o@(R _ ro) q@(R _ rq) =+  let r = mkApp15 p sr rf ra rb rc rd re rg rh ri rj rk rl rm rn ro rq+  in  wrapResult sr r (pap14 sr p r (f r a) b c d e g h i j k l m n o q)++-- helper functions for ap*++pap1 :: RefSrcPos -> RefExp -> RefExp -> R (Fun a z) -> R a -> R z+pap1 sr p r wf@(R (Fun f) rf) a =+  if r == rf +    then f r a+    else ap1 sr p wf a++pap2 :: RefSrcPos -> RefExp -> RefExp +     -> R (Fun a (Fun b z)) -> R a -> R b -> R z+pap2 sr p r wf@(R (Fun f) rf) a b =+  if r == rf +    then pap1 sr p r (f r a) b+    else ap2 sr p wf a b++pap3 :: RefSrcPos -> RefExp -> RefExp +     -> R (Fun a (Fun b (Fun c z))) -> R a -> R b -> R c -> R z+pap3 sr p r wf@(R (Fun f) rf) a b c =+  if r == rf +    then pap2 sr p r (f r a) b c+    else ap3 sr p wf a b c++pap4 :: RefSrcPos -> RefExp -> RefExp +     -> R (Fun a (Fun b (Fun c (Fun d z)))) -> R a -> R b -> R c -> R d -> R z+pap4 sr p r wf@(R (Fun f) rf) a b c d =+  if r == rf +    then pap3 sr p r (f r a) b c d+    else ap4 sr p wf a b c d++pap5 :: RefSrcPos -> RefExp -> RefExp +     -> R (Fun a (Fun b (Fun c (Fun d (Fun e z))))) +     -> R a -> R b -> R c -> R d -> R e -> R z+pap5 sr p r wf@(R (Fun f) rf) a b c d e =+  if r == rf +    then pap4 sr p r (f r a) b c d e+    else ap5 sr p wf a b c d e++pap6 :: RefSrcPos -> RefExp -> RefExp +     -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g z)))))) +     -> R a -> R b -> R c -> R d -> R e -> R g -> R z+pap6 sr p r wf@(R (Fun f) rf) a b c d e g =+  if r == rf +    then pap5 sr p r (f r a) b c d e g+    else ap6 sr p wf a b c d e g++pap7 :: RefSrcPos -> RefExp -> RefExp +     -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h z))))))) +     -> R a -> R b -> R c -> R d -> R e -> R g -> R h -> R z+pap7 sr p r wf@(R (Fun f) rf) a b c d e g h =+  if r == rf +    then pap6 sr p r (f r a) b c d e g h +    else ap7 sr p wf a b c d e g h++pap8 :: RefSrcPos -> RefExp -> RefExp +     -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i z)))))))) +     -> R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> R z+pap8 sr p r wf@(R (Fun f) rf) a b c d e g h i =+  if r == rf +    then pap7 sr p r (f r a) b c d e g h i+    else ap8 sr p wf a b c d e g h i++pap9 :: RefSrcPos -> RefExp -> RefExp +     -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i +        (Fun j z))))))))) +     -> R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> R j -> R z+pap9 sr p r wf@(R (Fun f) rf) a b c d e g h i j =+  if r == rf +    then pap8 sr p r (f r a) b c d e g h i j+    else ap9 sr p wf a b c d e g h i j++pap10 :: RefSrcPos -> RefExp -> RefExp +      -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i (Fun j +         (Fun k z)))))))))) +      -> R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> R j -> R k +      -> R z+pap10 sr p r wf@(R (Fun f) rf) a b c d e g h i j k =+  if r == rf +    then pap9 sr p r (f r a) b c d e g h i j k+    else ap10 sr p wf a b c d e g h i j k++pap11 :: RefSrcPos -> RefExp -> RefExp +      -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i (Fun j +         (Fun k (Fun l z)))))))))))+      -> R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> R j -> R k +      -> R l -> R z+pap11 sr p r wf@(R (Fun f) rf) a b c d e g h i j k l =+  if r == rf +    then pap10 sr p r (f r a) b c d e g h i j k l+    else ap11 sr p wf a b c d e g h i j k l++pap12 :: RefSrcPos -> RefExp -> RefExp +      -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i (Fun j +         (Fun k (Fun l (Fun m z)))))))))))) +      -> R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> R j -> R k +      -> R l -> R m -> R z+pap12 sr p r wf@(R (Fun f) rf) a b c d e g h i j k l m =+  if r == rf +    then pap11 sr p r (f r a) b c d e g h i j k l m+    else ap12 sr p wf a b c d e g h i j k l m++pap13 :: RefSrcPos -> RefExp -> RefExp +      -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i (Fun j+         (Fun k (Fun l (Fun m (Fun n z))))))))))))) +      -> R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> R j -> R k +      -> R l -> R m -> R n -> R z+pap13 sr p r wf@(R (Fun f) rf) a b c d e g h i j k l m n =+  if r == rf +    then pap12 sr p r (f r a) b c d e g h i j k l m n+    else ap13 sr p wf a b c d e g h i j k l m n++pap14 :: RefSrcPos -> RefExp -> RefExp +      -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i (Fun j+         (Fun k (Fun l (Fun m (Fun n (Fun o z)))))))))))))) +      -> R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> R j -> R k +      -> R l -> R m -> R n -> R o -> R z+pap14 sr p r wf@(R (Fun f) rf) a b c d e g h i j k l m n o =+  if r == rf +    then pap13 sr p r (f r a) b c d e g h i j k l m n o+    else ap14 sr p wf a b c d e g h i j k l m n o++-- combinators for n-ary traced abstraction++fun1 :: RefAtom -> RefSrcPos -> RefExp -> (R a -> RefExp -> R z)+     -> R (Fun a z)+fun1 var sr p f =+  let rf = mkValueUse p sr var+  in R (-- entValueUse rf sr `seq` +         Fun (\t a -> +                if hidden t +                  then let r = mkApp1 t mkNoSrcPos rf (refExp a) +                       in  recordChild t r `seq` +                           wrapResult mkNoSrcPos r (f a r)+                  else f a t))+       rf ++fun2 :: RefAtom -> RefSrcPos -> RefExp -> (R a -> R b -> RefExp -> R z)+     -> R (Fun a (Fun b z))+fun2 var sr p f =+  let rf = mkValueUse p sr var+  in R (-- entValueUse rf sr `seq` +         Fun (\t a -> +           R (Fun (\t b ->+                     if hidden t +                       then let r = mkApp2 t mkNoSrcPos rf (refExp a) +                                      (refExp b)+                            in  recordChild t r `seq` +                                wrapResult mkNoSrcPos r (f a b r)+                       else f a b t))+             t))+       rf ++fun3 :: RefAtom -> RefSrcPos -> RefExp -> (R a -> R b -> R c -> RefExp -> R z)+     -> R (Fun a (Fun b (Fun c z)))+fun3 var sr p f =+  let rf = mkValueUse p sr var+  in R (Fun (\t a -> +       R (Fun (\t b ->+         R (Fun (\t c ->+           if hidden t +             then let r = mkApp3 t mkNoSrcPos rf (refExp a) +                            (refExp b) (refExp c)+                  in  recordChild t r `seq` +                      wrapResult mkNoSrcPos r (f a b c r)+             else f a b c t))+           t))+         t))+       rf ++fun4 :: RefAtom -> RefSrcPos -> RefExp +     -> (R a -> R b -> R c -> R d -> RefExp -> R z)+     -> R (Fun a (Fun b (Fun c (Fun d z))))+fun4 var sr p f =+  let rf = mkValueUse p sr var+  in R (Fun (\t a -> +       R (Fun (\t b ->+         R (Fun (\t c ->+           R (Fun (\t d -> +             if hidden t +               then let r = mkApp4 t mkNoSrcPos rf (refExp a) +                              (refExp b) (refExp c) (refExp d)+                    in  recordChild t r `seq` +                        wrapResult mkNoSrcPos r (f a b c d r)+               else f a b c d t))+             t))+           t))+         t))+       rf ++fun5 :: RefAtom -> RefSrcPos -> RefExp +     -> (R a -> R b -> R c -> R d -> R e -> RefExp -> R z)+     -> R (Fun a (Fun b (Fun c (Fun d (Fun e z)))))+fun5 var sr p f =+  let rf = mkValueUse p sr var+  in R (Fun (\t a -> +       R (Fun (\t b ->+         R (Fun (\t c ->+           R (Fun (\t d -> +             R (Fun (\t e -> +               if hidden t +                 then let r = mkApp5 t mkNoSrcPos rf (refExp a) (refExp b) +                                (refExp c) (refExp d) (refExp e)+                      in  recordChild t r `seq` +                          wrapResult mkNoSrcPos r (f a b c d e r)+                 else f a b c d e t))+               t))+             t))+           t))+         t))+       rf +++fun6 :: RefAtom -> RefSrcPos -> RefExp +     -> (R a -> R b -> R c -> R d -> R e -> R g -> RefExp -> R z)+     -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g z))))))+fun6 var sr p f =+  let rf = mkValueUse p sr var+  in R (Fun (\t a -> +       R (Fun (\t b ->+         R (Fun (\t c ->+           R (Fun (\t d -> +             R (Fun (\t e -> +               R (Fun (\t g ->+                 if hidden t +                   then let r = mkApp6 t mkNoSrcPos rf (refExp a) (refExp b) +                                  (refExp c) (refExp d) (refExp e) (refExp g)+                        in  recordChild t r `seq` +                            wrapResult mkNoSrcPos r (f a b c d e g r)+                   else f a b c d e g t))+                 t))+               t))+             t))+           t))+         t))+       rf ++fun7 :: RefAtom -> RefSrcPos -> RefExp +     -> (R a -> R b -> R c -> R d -> R e -> R g -> R h -> RefExp -> R z)+     -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h z)))))))+fun7 var sr p f =+  let rf = mkValueUse p sr var+  in R (Fun (\t a -> +       R (Fun (\t b ->+         R (Fun (\t c ->+           R (Fun (\t d -> +             R (Fun (\t e -> +               R (Fun (\t g ->+                 R (Fun (\t h ->+                   if hidden t +                     then let r = mkApp7 t mkNoSrcPos rf (refExp a) (refExp b) +                                    (refExp c) (refExp d) (refExp e) (refExp g)+                                    (refExp h)+                          in  recordChild t r `seq` +                              wrapResult mkNoSrcPos r (f a b c d e g h r)+                     else f a b c d e g h t))+                   t))+                 t))+               t))+             t))+           t))+         t))+       rf ++fun8 :: RefAtom -> RefSrcPos -> RefExp +     -> (R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> RefExp -> R z)+     -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i z))))))))+fun8 var sr p f =+  let rf = mkValueUse p sr var+  in R (Fun (\t a -> +       R (Fun (\t b ->+         R (Fun (\t c ->+           R (Fun (\t d -> +             R (Fun (\t e -> +               R (Fun (\t g ->+                 R (Fun (\t h ->+                   R (Fun (\t i ->+                     if hidden t +                       then let r = mkApp8 t mkNoSrcPos rf (refExp a) +                                      (refExp b) (refExp c) (refExp d) +                                      (refExp e) (refExp g) (refExp h)+                                      (refExp i)+                            in  recordChild t r `seq` +                                wrapResult mkNoSrcPos r (f a b c d e g h i r)+                       else f a b c d e g h i t))+                     t))+                   t))+                 t))+               t))+             t))+           t))+         t))+       rf ++fun9 :: RefAtom -> RefSrcPos -> RefExp +     -> (R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> R j +         -> RefExp -> R z)+     -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i +          (Fun j z)))))))))+fun9 var sr p f =+  let rf = mkValueUse p sr var+  in R (Fun (\t a -> +       R (Fun (\t b ->+         R (Fun (\t c ->+           R (Fun (\t d -> +             R (Fun (\t e -> +               R (Fun (\t g ->+                 R (Fun (\t h ->+                   R (Fun (\t i ->+                     R (Fun (\t j ->+                       if hidden t +                         then let r = mkApp9 t mkNoSrcPos rf (refExp a) +                                        (refExp b) (refExp c) (refExp d) +                                        (refExp e) (refExp g) (refExp h)+                                        (refExp i) (refExp j)+                              in  recordChild t r `seq`+                                  wrapResult mkNoSrcPos r +                                    (f a b c d e g h i j r)+                         else f a b c d e g h i j t))+                       t))+                     t))+                   t))+                 t))+               t))+             t))+           t))+         t))+       rf ++fun10 :: RefAtom -> RefSrcPos -> RefExp +      -> (R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> R j -> R k+          -> RefExp -> R z)+      -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i +           (Fun j (Fun k z))))))))))+fun10 var sr p f =+  let rf = mkValueUse p sr var+  in R (Fun (\t a -> +       R (Fun (\t b ->+         R (Fun (\t c ->+           R (Fun (\t d -> +             R (Fun (\t e -> +               R (Fun (\t g ->+                 R (Fun (\t h ->+                   R (Fun (\t i ->+                     R (Fun (\t j ->+                       R (Fun (\t k ->+                       if hidden t +                         then let r = mkApp10 t mkNoSrcPos rf (refExp a) +                                        (refExp b) (refExp c) (refExp d) +                                        (refExp e) (refExp g) (refExp h)+                                        (refExp i) (refExp j) (refExp k)+                              in  recordChild t r `seq` +                                  wrapResult mkNoSrcPos r +                                    (f a b c d e g h i j k r)+                         else f a b c d e g h i j k t))+                         t))+                       t))+                     t))+                   t))+                 t))+               t))+             t))+           t))+         t))+       rf ++fun11 :: RefAtom -> RefSrcPos -> RefExp +      -> (R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> R j -> R k+          -> R l -> RefExp -> R z)+      -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i +           (Fun j (Fun k (Fun l z)))))))))))+fun11 var sr p f =+  let rf = mkValueUse p sr var+  in R (Fun (\t a -> +       R (Fun (\t b ->+         R (Fun (\t c ->+           R (Fun (\t d -> +             R (Fun (\t e -> +               R (Fun (\t g ->+                 R (Fun (\t h ->+                   R (Fun (\t i ->+                     R (Fun (\t j ->+                       R (Fun (\t k ->+                         R (Fun (\t l ->+                       if hidden t +                         then let r = mkApp11 t mkNoSrcPos rf (refExp a) +                                        (refExp b) (refExp c) (refExp d) +                                        (refExp e) (refExp g) (refExp h)+                                        (refExp i) (refExp j) (refExp k)+                                        (refExp l)+                              in  recordChild t r `seq` +                                  wrapResult mkNoSrcPos r +                                    (f a b c d e g h i j k l r)+                         else f a b c d e g h i j k l t))+                           t))+                         t))+                       t))+                     t))+                   t))+                 t))+               t))+             t))+           t))+         t))+       rf ++fun12 :: RefAtom -> RefSrcPos -> RefExp +      -> (R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> R j -> R k+          -> R l -> R m -> RefExp -> R z)+      -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i +           (Fun j (Fun k (Fun l (Fun m z))))))))))))+fun12 var sr p f =+  let rf = mkValueUse p sr var+  in R (Fun (\t a -> +       R (Fun (\t b ->+         R (Fun (\t c ->+           R (Fun (\t d -> +             R (Fun (\t e -> +               R (Fun (\t g ->+                 R (Fun (\t h ->+                   R (Fun (\t i ->+                     R (Fun (\t j ->+                       R (Fun (\t k ->+                         R (Fun (\t l ->+                           R (Fun (\t m ->+                       if hidden t +                         then let r = mkApp12 t mkNoSrcPos rf (refExp a) +                                        (refExp b) (refExp c) (refExp d) +                                        (refExp e) (refExp g) (refExp h)+                                        (refExp i) (refExp j) (refExp k)+                                        (refExp l) (refExp m)+                              in  recordChild t r `seq` +                                  wrapResult mkNoSrcPos r +                                    (f a b c d e g h i j k l m r)+                         else f a b c d e g h i j k l m t))+                             t))+                           t))+                         t))+                       t))+                     t))+                   t))+                 t))+               t))+             t))+           t))+         t))+       rf ++fun13 :: RefAtom -> RefSrcPos -> RefExp +      -> (R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> R j -> R k+          -> R l -> R m -> R n -> RefExp -> R z)+      -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i +           (Fun j (Fun k (Fun l (Fun m (Fun n z)))))))))))))+fun13 var sr p f =+  let rf = mkValueUse p sr var+  in R (Fun (\t a -> +       R (Fun (\t b ->+         R (Fun (\t c ->+           R (Fun (\t d -> +             R (Fun (\t e -> +               R (Fun (\t g ->+                 R (Fun (\t h ->+                   R (Fun (\t i ->+                     R (Fun (\t j ->+                       R (Fun (\t k ->+                         R (Fun (\t l ->+                           R (Fun (\t m ->+                             R (Fun (\t n ->+                       if hidden t +                         then let r = mkApp13 t mkNoSrcPos rf (refExp a) +                                        (refExp b) (refExp c) (refExp d) +                                        (refExp e) (refExp g) (refExp h)+                                        (refExp i) (refExp j) (refExp k)+                                        (refExp l) (refExp m) (refExp n)+                              in  recordChild t r `seq` +                                  wrapResult mkNoSrcPos r +                                    (f a b c d e g h i j k l m n r)+                         else f a b c d e g h i j k l m n t))+                               t))+                             t))+                           t))+                         t))+                       t))+                     t))+                   t))+                 t))+               t))+             t))+           t))+         t))+       rf ++fun14 :: RefAtom -> RefSrcPos -> RefExp +      -> (R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> R j -> R k+          -> R l -> R m -> R n -> R o -> RefExp -> R z)+      -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i +           (Fun j (Fun k (Fun l (Fun m (Fun n (Fun o z))))))))))))))+fun14 var sr p f =+  let rf = mkValueUse p sr var+  in R (Fun (\t a -> +       R (Fun (\t b ->+         R (Fun (\t c ->+           R (Fun (\t d -> +             R (Fun (\t e -> +               R (Fun (\t g ->+                 R (Fun (\t h ->+                   R (Fun (\t i ->+                     R (Fun (\t j ->+                       R (Fun (\t k ->+                         R (Fun (\t l ->+                           R (Fun (\t m ->+                             R (Fun (\t n ->+                               R (Fun (\t o ->+                       if hidden t +                         then let r = mkApp14 t mkNoSrcPos rf (refExp a) +                                        (refExp b) (refExp c) (refExp d) +                                        (refExp e) (refExp g) (refExp h)+                                        (refExp i) (refExp j) (refExp k)+                                        (refExp l) (refExp m) (refExp n)+                                        (refExp o)+                              in  recordChild t r `seq` +                                  wrapResult mkNoSrcPos r +                                    (f a b c d e g h i j k l m n o r)+                         else f a b c d e g h i j k l m n o t))+                                 t))+                               t))+                             t))+                           t))+                         t))+                       t))+                     t))+                   t))+                 t))+               t))+             t))+           t))+         t))+       rf ++fun15 :: RefAtom -> RefSrcPos -> RefExp +      -> (R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> R j -> R k+          -> R l -> R m -> R n -> R o -> R q -> RefExp -> R z)+      -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i +           (Fun j (Fun k (Fun l (Fun m (Fun n (Fun o (Fun q z)))))))))))))))+fun15 var sr p f =+  let rf = mkValueUse p sr var+  in R (Fun (\t a -> +       R (Fun (\t b ->+         R (Fun (\t c ->+           R (Fun (\t d -> +             R (Fun (\t e -> +               R (Fun (\t g ->+                 R (Fun (\t h ->+                   R (Fun (\t i ->+                     R (Fun (\t j ->+                       R (Fun (\t k ->+                         R (Fun (\t l ->+                           R (Fun (\t m ->+                             R (Fun (\t n ->+                               R (Fun (\t o ->+                                 R (Fun (\t q ->+                       if hidden t +                         then let r = mkApp15 t mkNoSrcPos rf (refExp a) +                                        (refExp b) (refExp c) (refExp d) +                                        (refExp e) (refExp g) (refExp h)+                                        (refExp i) (refExp j) (refExp k)+                                        (refExp l) (refExp m) (refExp n)+                                        (refExp o) (refExp q)+                              in  recordChild t r `seq` +                                  wrapResult mkNoSrcPos r +                                    (f a b c d e g h i j k l m n o q r)+                         else f a b c d e g h i j k l m n o q t))+                                   t))+                                 t))+                               t))+                             t))+                           t))+                         t))+                       t))+                     t))+                   t))+                 t))+               t))+             t))+           t))+         t))+       rf +++-- combinators for n-ary untraced applications++uap1 :: RefSrcPos -> RefExp -> R (Fun a z) -> R a -> R z+uap1 sr h (R (Fun f) _) a = uwrapForward h (f h a)++uap2 :: RefSrcPos -> RefExp -> R (Fun a (Fun b z)) -> R a -> R b -> R z+uap2 sr h f a b = uwrapForward h $+  case uap1 sr h f a of+    R (Fun f) _ -> f h b++uap3 :: RefSrcPos -> RefExp -> R (Fun a (Fun b (Fun c z))) +     -> R a -> R b -> R c -> R z+uap3 sr h f a b c = uwrapForward h $+  case uap2 sr h f a b of+    R (Fun f) _ -> f h c++uap4 :: RefSrcPos -> RefExp -> R (Fun a (Fun b (Fun c (Fun d z)))) +     -> R a -> R b -> R c -> R d -> R z+uap4 sr h f a b c d = uwrapForward h $+  case uap3 sr h f a b c of+    R (Fun f) _ -> f h d++uap5 :: RefSrcPos -> RefExp -> R (Fun a (Fun b (Fun c (Fun d (Fun e z))))) +     -> R a -> R b -> R c -> R d -> R e -> R z+uap5 sr h f a b c d e = uwrapForward h (upap5 h f a b c d e)++uap6 :: RefSrcPos -> RefExp +     -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g z)))))) +     -> R a -> R b -> R c -> R d -> R e -> R g -> R z+uap6 sr h f a b c d e g = uwrapForward h (upap6 h f a b c d e g)++uap7 :: RefSrcPos -> RefExp +     -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h z))))))) +     -> R a -> R b -> R c -> R d -> R e -> R g -> R h -> R z+uap7 sr p f a b c d e g h = uwrapForward p (upap7 p f a b c d e g h)++uap8 :: RefSrcPos -> RefExp +     -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i z)))))))) +     -> R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> R z+uap8 sr p f a b c d e g h i = uwrapForward p (upap8 p f a b c d e g h i)+++upap1 :: RefExp -> R (Fun a z) -> R a -> R z+upap1 h (R (Fun f) _) a = f h a++upap2 :: RefExp -> R (Fun a (Fun b z)) -> R a -> R b -> R z+upap2 h f a b = +  case upap1 h f a of+    R (Fun f) _ -> f h b++upap3 :: RefExp -> R (Fun a (Fun b (Fun c z))) +      -> R a -> R b -> R c -> R z+upap3 h f a b c = +  case upap2 h f a b of+    R (Fun f) _ -> f h c++upap4 :: RefExp -> R (Fun a (Fun b (Fun c (Fun d z)))) +      -> R a -> R b -> R c -> R d -> R z+upap4 h f a b c d =+  case upap3 h f a b c of+    R (Fun f) _ -> f h d++upap5 :: RefExp -> R (Fun a (Fun b (Fun c (Fun d (Fun e z))))) +      -> R a -> R b -> R c -> R d -> R e -> R z+upap5 h f a b c d e = +  case upap4 h f a b c d of+    R (Fun f) _ -> f h e ++upap6 :: RefExp +      -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g z)))))) +      -> R a -> R b -> R c -> R d -> R e -> R g -> R z+upap6 h f a b c d e g = +  case upap5 h f a b c d e of+    R (Fun f) _ -> f h g++upap7 :: RefExp +      -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h z))))))) +      -> R a -> R b -> R c -> R d -> R e -> R g -> R h -> R z+upap7 p f a b c d e g h =+  case upap6 p f a b c d e g of+    R (Fun f) _ -> f p h++upap8 :: RefExp +      -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i z)))))))) +      -> R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i -> R z+upap8 p f a b c d e g h i =+  case upap7 p f a b c d e g h of+    R (Fun f) _ -> f p i+++-- combinators for n-ary untraced abstraction (function construction)+++ufun1 :: RefAtom -> RefSrcPos -> RefExp -> (R a -> RefExp -> R r) +      -> R (Fun a r)+ufun1 at sr p f = R (Fun (\r a -> hide r (f a))) (mkValueUse p sr at)++ufun2 :: RefAtom -> RefSrcPos -> RefExp -> (R a -> R b -> RefExp -> R r)+      -> R (Fun a (Fun b r))+ufun2 at sr p f =+  R (Fun (\r a ->+    R (Fun (\r b -> hide r (f a b)))+      r))+    (mkValueUse p sr at)++ufun3 :: RefAtom -> RefSrcPos -> RefExp -> (R a -> R b -> R c -> RefExp -> R r)+      -> R (Fun a (Fun b (Fun c r)))+ufun3 at sr p f =+  R (Fun (\r a ->+    R (Fun (\r b ->+      R (Fun (\r c -> hide r (f a b c)))+        r))+      r))+    (mkValueUse p sr at)++ufun4 :: RefAtom -> RefSrcPos -> RefExp +      -> (R a -> R b -> R c -> R d -> RefExp -> R r)+      -> R (Fun a (Fun b (Fun c (Fun d r))))+ufun4 at sr p f =+  R (Fun (\r a ->+    R (Fun (\r b ->+      R (Fun (\r c -> +        R (Fun (\r d -> hide r (f a b c d)))+          r))+        r))+      r))+    (mkValueUse p sr at)++ufun5 :: RefAtom -> RefSrcPos -> RefExp +      -> (R a -> R b -> R c -> R d -> R e -> RefExp -> R r)+      -> R (Fun a (Fun b (Fun c (Fun d (Fun e r)))))+ufun5 at sr p f =+  R (Fun (\r a ->+    R (Fun (\r b ->+      R (Fun (\r c -> +        R (Fun (\r d -> +          R (Fun (\r e -> hide r (f a b c d e)))+            r))+          r))+        r))+      r))+    (mkValueUse p sr at)++ufun6 :: RefAtom -> RefSrcPos -> RefExp +      -> (R a -> R b -> R c -> R d -> R e -> R g -> RefExp -> R r)+      -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g r))))))+ufun6 at sr p f =+  R (Fun (\r a ->+    R (Fun (\r b ->+      R (Fun (\r c -> +        R (Fun (\r d -> +          R (Fun (\r e -> +            R (Fun (\r g -> hide r (f a b c d e g)))+              r))+            r))+          r))+        r))+      r))+    (mkValueUse p sr at)++ufun7 :: RefAtom -> RefSrcPos -> RefExp +      -> (R a -> R b -> R c -> R d -> R e -> R g -> R h -> RefExp -> R r)+      -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h r)))))))+ufun7 at sr p f =+  R (Fun (\r a ->+    R (Fun (\r b ->+      R (Fun (\r c -> +        R (Fun (\r d -> +          R (Fun (\r e -> +            R (Fun (\r g -> +              R (Fun (\r h -> hide r (f a b c d e g h)))+                r))+              r))+            r))+          r))+        r))+      r))+    (mkValueUse p sr at)++ufun8 :: RefAtom -> RefSrcPos -> RefExp +      -> (R a -> R b -> R c -> R d -> R e -> R g -> R h -> R i +          -> RefExp -> R r)+      -> R (Fun a (Fun b (Fun c (Fun d (Fun e (Fun g (Fun h (Fun i r))))))))+ufun8 at sr p f =+  R (Fun (\r a ->+    R (Fun (\r b ->+      R (Fun (\r c -> +        R (Fun (\r d -> +          R (Fun (\r e -> +            R (Fun (\r g -> +              R (Fun (\r h -> +                R (Fun (\r i -> hide r (f a b c d e g h i)))+                  r))+                r))+              r))+            r))+          r))+        r))+      r))+    (mkValueUse p sr at)++-- Combinators for saturated n-ary applications of data constructors++con0 :: RefSrcPos -> RefExp -> z -> RefAtom -> R z+con0 sr p cn at =+  R cn (mkValueUse p sr at)++con1 :: RefSrcPos -> RefExp -> (R a -> z) -> RefAtom -> R a -> R z+con1 sr p cn at a@(R _ ra) =+  R (cn a) (mkValueApp1 p sr at ra)++con2 :: RefSrcPos -> RefExp +     -> (R a -> R b -> z) -> RefAtom -> R a -> R b -> R z+con2 sr p cn at a@(R _ ra) b@(R _ rb) =+  R (cn a b) (mkValueApp2 p sr at ra rb)++con3 :: RefSrcPos -> RefExp +     -> (R a -> R b -> R c -> z) -> RefAtom -> R a -> R b -> R c -> R z+con3 sr p cn at a@(R _ ra) b@(R _ rb) c@(R _ rc) =+  R (cn a b c) (mkValueApp3 p sr at ra rb rc)++con4 :: RefSrcPos -> RefExp +     -> (R a -> R b -> R c -> R d -> z) -> RefAtom +     -> R a -> R b -> R c -> R d -> R z+con4 sr p cn at a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) =+  R (cn a b c d) (mkValueApp4 p sr at ra rb rc rd)++con5 :: RefSrcPos -> RefExp +     -> (R a -> R b -> R c -> R d -> R e -> z) -> RefAtom +     -> R a -> R b -> R c -> R d -> R e -> R z+con5 sr p cn at a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) e@(R _ re) =+  R (cn a b c d e) (mkValueApp5 p sr at ra rb rc rd re)++con6 :: RefSrcPos -> RefExp +     -> (R a -> R b -> R c -> R d -> R e -> R f -> z) -> RefAtom +     -> R a -> R b -> R c -> R d -> R e -> R f -> R z+con6 sr p cn at a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) e@(R _ re) +  f@(R _ rf) =+  R (cn a b c d e f) (mkValueApp6 p sr at ra rb rc rd re rf)++con7 :: RefSrcPos -> RefExp +     -> (R a -> R b -> R c -> R d -> R e -> R f -> R g -> z) -> RefAtom +     -> R a -> R b -> R c -> R d -> R e -> R f -> R g -> R z+con7 sr p cn at a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) e@(R _ re) +  f@(R _ rf) g@(R _ rg) =+  R (cn a b c d e f g) +    (mkValueApp7 p sr at ra rb rc rd re rf rg)++con8 :: RefSrcPos -> RefExp +     -> (R a -> R b -> R c -> R d -> R e -> R f -> R g -> R h -> z) -> RefAtom +     -> R a -> R b -> R c -> R d -> R e -> R f -> R g -> R h -> R z+con8 sr p cn at a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) e@(R _ re) +  f@(R _ rf) g@(R _ rg) h@(R _ rh) =+  R (cn a b c d e f g h) +    (mkValueApp8 p sr at ra rb rc rd re rf rg rh)++con9 :: RefSrcPos -> RefExp +     -> (R a -> R b -> R c -> R d -> R e -> R f -> R g -> R h -> R i -> z) +     -> RefAtom +     -> R a -> R b -> R c -> R d -> R e -> R f -> R g -> R h -> R i -> R z+con9 sr p cn at a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) e@(R _ re) +  f@(R _ rf) g@(R _ rg) h@(R _ rh) i@(R _ ri) =+  R (cn a b c d e f g h i) +    (mkValueApp9 p sr at ra rb rc rd re rf rg rh ri)++con10 :: RefSrcPos -> RefExp +     -> (R a -> R b -> R c -> R d -> R e -> R f -> R g -> R h -> R i -> R j +         -> z) +     -> RefAtom +     -> R a -> R b -> R c -> R d -> R e -> R f -> R g -> R h -> R i -> R j +     -> R z+con10 sr p cn at a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) e@(R _ re) +  f@(R _ rf) g@(R _ rg) h@(R _ rh) i@(R _ ri) j@(R _ rj) =+  R (cn a b c d e f g h i j) +    (mkValueApp10 p sr at ra rb rc rd re rf rg rh ri rj)++con11 :: RefSrcPos -> RefExp +     -> (R a -> R b -> R c -> R d -> R e -> R f -> R g -> R h -> R i -> R j +         -> R k -> z) +     -> RefAtom +     -> R a -> R b -> R c -> R d -> R e -> R f -> R g -> R h -> R i -> R j +     -> R k -> R z+con11 sr p cn at a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) e@(R _ re) +  f@(R _ rf) g@(R _ rg) h@(R _ rh) i@(R _ ri) j@(R _ rj) k@(R _ rk) =+  R (cn a b c d e f g h i j k) +    (mkValueApp11 p sr at ra rb rc rd re rf rg rh ri rj rk)++con12 :: RefSrcPos -> RefExp +     -> (R a -> R b -> R c -> R d -> R e -> R f -> R g -> R h -> R i -> R j +         -> R k -> R l -> z) +     -> RefAtom +     -> R a -> R b -> R c -> R d -> R e -> R f -> R g -> R h -> R i -> R j +     -> R k -> R l -> R z+con12 sr p cn at a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) e@(R _ re) +  f@(R _ rf) g@(R _ rg) h@(R _ rh) i@(R _ ri) j@(R _ rj) k@(R _ rk) +  l@(R _ rl) =+  R (cn a b c d e f g h i j k l) +    (mkValueApp12 p sr at ra rb rc rd re rf rg rh ri rj rk rl)++con13 :: RefSrcPos -> RefExp +     -> (R a -> R b -> R c -> R d -> R e -> R f -> R g -> R h -> R i -> R j +         -> R k -> R l -> R m -> z) +     -> RefAtom +     -> R a -> R b -> R c -> R d -> R e -> R f -> R g -> R h -> R i -> R j +     -> R k -> R l -> R m -> R z+con13 sr p cn at a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) e@(R _ re) +  f@(R _ rf) g@(R _ rg) h@(R _ rh) i@(R _ ri) j@(R _ rj) k@(R _ rk) +  l@(R _ rl) m@(R _ rm) =+  R (cn a b c d e f g h i j k l m) +    (mkValueApp13 p sr at ra rb rc rd re rf rg rh ri rj rk rl rm)++con14 :: RefSrcPos -> RefExp +     -> (R a -> R b -> R c -> R d -> R e -> R f -> R g -> R h -> R i -> R j +         -> R k -> R l -> R m -> R n -> z) +     -> RefAtom +     -> R a -> R b -> R c -> R d -> R e -> R f -> R g -> R h -> R i -> R j +     -> R k -> R l -> R m -> R n -> R z+con14 sr p cn at a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) e@(R _ re) +  f@(R _ rf) g@(R _ rg) h@(R _ rh) i@(R _ ri) j@(R _ rj) k@(R _ rk) +  l@(R _ rl) m@(R _ rm) n@(R _ rn) =+  R (cn a b c d e f g h i j k l m n) +    (mkValueApp14 p sr at ra rb rc rd re rf rg rh ri rj rk rl rm rn)++con15 :: RefSrcPos -> RefExp +     -> (R a -> R b -> R c -> R d -> R e -> R f -> R g -> R h -> R i -> R j +         -> R k -> R l -> R m -> R n -> R o -> z) +     -> RefAtom +     -> R a -> R b -> R c -> R d -> R e -> R f -> R g -> R h -> R i -> R j +     -> R k -> R l -> R m -> R n -> R o -> R z+con15 sr p cn at a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) e@(R _ re) +  f@(R _ rf) g@(R _ rg) h@(R _ rh) i@(R _ ri) j@(R _ rj) k@(R _ rk) +  l@(R _ rl) m@(R _ rm) n@(R _ rn) o@(R _ ro) =+  R (cn a b c d e f g h i j k l m n o) +    (mkValueApp15 p sr at ra rb rc rd re rf rg rh ri rj rk rl rm rn ro)+++-- Create application node for function that is partially applied to i+-- arguments and transform partial application with given function.+-- Used for partially applied data constructors.++pa0 :: b -> (b -> RefExp -> c) -> RefSrcPos -> RefExp -> RefAtom -> c+pa0 c cni sr p at =+  cni c (mkValueUse p sr at) +++pa1 :: (R a1 -> b) -> (b -> RefExp -> c) +    -> RefSrcPos -> RefExp -> RefAtom -> R a1 -> c+pa1 c cni sr p at a1@(R _ r1) =+  cni (c a1) (mkValueApp1 p sr at r1)+++pa2 :: (R a1 -> R a2 -> b) -> (b -> RefExp -> c) +    -> RefSrcPos -> RefExp -> RefAtom+    -> R a1 -> R a2 -> c+pa2 c cni sr p at a1@(R _ r1) a2@(R _ r2) =+  cni (c a1 a2) (mkValueApp2 p sr at r1 r2)+++pa3 :: (R a1 -> R a2 -> R a3 -> b) -> (b -> RefExp -> c) +    -> RefSrcPos -> RefExp -> RefAtom+    -> R a1 -> R a2 -> R a3 -> c+pa3 c cni sr p at a1@(R _ r1) a2@(R _ r2) a3@(R _ r3) =+  cni (c a1 a2 a3) (mkValueApp3 p sr at r1 r2 r3)+++pa4 :: (R a1 -> R a2 -> R a3 -> R a4 -> b) -> (b -> RefExp -> c) +    -> RefSrcPos -> RefExp -> RefAtom+    -> R a1 -> R a2 -> R a3 -> R a4 -> c+pa4 c cni sr p at a1@(R _ r1) a2@(R _ r2) a3@(R _ r3) a4@(R _ r4) =+  cni (c a1 a2 a3 a4) (mkValueApp4 p sr at r1 r2 r3 r4)++pa5 :: (R a1 -> R a2 -> R a3 -> R a4 -> R a5 -> b) -> (b -> RefExp -> c) +    -> RefSrcPos -> RefExp -> RefAtom+    -> R a1 -> R a2 -> R a3 -> R a4 -> R a5 -> c+pa5 c cni sr p at a1@(R _ r1) a2@(R _ r2) a3@(R _ r3) a4@(R _ r4) a5@(R _ r5) =+  cni (c a1 a2 a3 a4 a5) (mkValueApp5 p sr at r1 r2 r3 r4 r5)++pa6 :: (R a1 -> R a2 -> R a3 -> R a4 -> R a5 -> R a6 -> b) +    -> (b -> RefExp -> c) +    -> RefSrcPos -> RefExp -> RefAtom+    -> R a1 -> R a2 -> R a3 -> R a4 -> R a5 -> R a6 -> c+pa6 c cni sr p at a1@(R _ r1) a2@(R _ r2) a3@(R _ r3) a4@(R _ r4) a5@(R _ r5)+  a6@(R _ r6) =+  cni (c a1 a2 a3 a4 a5 a6) (mkValueApp6 p sr at r1 r2 r3 r4 r5 r6)++pa7 :: (R a1 -> R a2 -> R a3 -> R a4 -> R a5 -> R a6 -> R a7 -> b) +    -> (b -> RefExp -> c) +    -> RefSrcPos -> RefExp -> RefAtom+    -> R a1 -> R a2 -> R a3 -> R a4 -> R a5 -> R a6 -> R a7 -> c+pa7 c cni sr p at a1@(R _ r1) a2@(R _ r2) a3@(R _ r3) a4@(R _ r4) a5@(R _ r5)+  a6@(R _ r6) a7@(R _ r7) =+  cni (c a1 a2 a3 a4 a5 a6 a7) (mkValueApp7 p sr at r1 r2 r3 r4 r5 r6 r7)++pa8 :: (R a1 -> R a2 -> R a3 -> R a4 -> R a5 -> R a6 -> R a7 -> R a8 -> b) +    -> (b -> RefExp -> c) +    -> RefSrcPos -> RefExp -> RefAtom+    -> R a1 -> R a2 -> R a3 -> R a4 -> R a5 -> R a6 -> R a7 -> R a8 -> c+pa8 c cni sr p at a1@(R _ r1) a2@(R _ r2) a3@(R _ r3) a4@(R _ r4) a5@(R _ r5)+  a6@(R _ r6) a7@(R _ r7) a8@(R _ r8) =+  cni (c a1 a2 a3 a4 a5 a6 a7 a8) (mkValueApp8 p sr at r1 r2 r3 r4 r5 r6 r7 r8)++-- Transform a function into a wrapped function with the given RefExp.+-- The application Exp is recorded by the application combinator.+-- Used for partially applied constructors++cn1 :: (R a1 -> b) -> RefExp -> R (Fun a1 b)+cn1 f rf = R (Fun (\r a ->+             R (f a)+               (if hidden r +                  then mkResApp1 r mkNoSrcPos rf (refExp a)+                  else r)))+             rf++cn2 :: (R a1 -> R a2 -> b) -> RefExp -> R (Fun a1 (Fun a2 b))+cn2 f rf = R (Fun (\r a ->+             R (Fun (\r b ->+               R (f a b)+                 (if hidden r +                    then mkResApp2 r mkNoSrcPos rf (refExp a) (refExp b)+                    else r)))+               r))+             rf++cn3 :: (R a1 -> R a2 -> R a3 -> b) -> RefExp -> R (Fun a1 (Fun a2 (Fun a3 b)))+cn3 f rf = R (Fun (\r a ->+             R (Fun (\r b ->+               R (Fun (\r c ->+                 R (f a b c)+                   (if hidden r +                      then mkResApp3 r mkNoSrcPos rf (refExp a) (refExp b) +                             (refExp c)+                      else r)))+                 r))r))rf++cn4 :: (R a1 -> R a2 -> R a3 -> R a4 -> b) -> RefExp +    -> R (Fun a1 (Fun a2 (Fun a3 (Fun a4 b))))+cn4 f rf = R (Fun (\r a ->+             R (Fun (\r b ->+               R (Fun (\r c ->+                 R (Fun (\r d ->+                   R (f a b c d)+                     (if hidden r +                        then mkResApp4 r mkNoSrcPos rf (refExp a) (refExp b) +                               (refExp c) (refExp d)+                        else r)))+                   r))r))r))rf++cn5 :: (R a1 -> R a2 -> R a3 -> R a4 -> R a5 -> b) -> RefExp +    -> R (Fun a1 (Fun a2 (Fun a3 (Fun a4 (Fun a5 b)))))+cn5 f rf = R (Fun (\r a ->+             R (Fun (\r b ->+               R (Fun (\r c ->+                 R (Fun (\r d ->+                   R (Fun (\r e ->+                     R (f a b c d e)+                       (if hidden r +                          then mkResApp5 r mkNoSrcPos rf (refExp a) (refExp b) +                                 (refExp c) (refExp d) (refExp e)+                          else r)))+                     r))r))r))r))rf++cn6 :: (R a1 -> R a2 -> R a3 -> R a4 -> R a5 -> R a6 -> b) -> RefExp +    -> R (Fun a1 (Fun a2 (Fun a3 (Fun a4 (Fun a5 (Fun a6 b))))))+cn6 f rf = R (Fun (\r a ->+             R (Fun (\r b ->+               R (Fun (\r c ->+                 R (Fun (\r d ->+                   R (Fun (\r e ->+                     R (Fun (\r g ->+                       R (f a b c d e g)+                         (if hidden r +                            then mkResApp6 r mkNoSrcPos rf (refExp a) +                                   (refExp b) (refExp c) (refExp d) (refExp e)+                                   (refExp g)+                            else r)))+                         r))r))r))r))r))rf++cn7 :: (R a1 -> R a2 -> R a3 -> R a4 -> R a5 -> R a6 -> R a7 -> b) -> RefExp +    -> R (Fun a1 (Fun a2 (Fun a3 (Fun a4 (Fun a5 (Fun a6 (Fun a7 b)))))))+cn7 f rf = R (Fun (\r a ->+             R (Fun (\r b ->+               R (Fun (\r c ->+                 R (Fun (\r d ->+                   R (Fun (\r e ->+                     R (Fun (\r g ->+                       R (Fun (\r h ->+                         R (f a b c d e g h)+                           (if hidden r +                              then mkResApp7 r mkNoSrcPos rf (refExp a) +                                     (refExp b) (refExp c) (refExp d) +                                     (refExp e) (refExp g) (refExp h)+                              else r)))+                         r))r))r))r))r))r))rf++cn8 :: (R a1 -> R a2 -> R a3 -> R a4 -> R a5 -> R a6 -> R a7 -> R a8 -> b) +    -> RefExp +    -> R (Fun a1 (Fun a2 (Fun a3 (Fun a4 (Fun a5 (Fun a6 (Fun a7 (Fun a8 +         b))))))))+cn8 f rf = R (Fun (\r a ->+             R (Fun (\r b ->+               R (Fun (\r c ->+                 R (Fun (\r d ->+                   R (Fun (\r e ->+                     R (Fun (\r g ->+                       R (Fun (\r h ->+                         R (Fun (\r i ->+                           R (f a b c d e g h i)+                             (if hidden r +                                then mkResApp8 r mkNoSrcPos rf (refExp a) +                                       (refExp b) (refExp c) (refExp d) +                                       (refExp e) (refExp g) (refExp h) +                                       (refExp i)+                                else r)))+                           r))r))r))r))r))r))r))rf++cn9 :: (R a1 -> R a2 -> R a3 -> R a4 -> R a5 -> R a6 -> R a7 -> R a8 -> R a9 +        -> b) +    -> RefExp +    -> R (Fun a1 (Fun a2 (Fun a3 (Fun a4 (Fun a5 (Fun a6 (Fun a7 (Fun a8 +         (Fun a9 b)))))))))+cn9 f rf = R (Fun (\r a ->+             R (Fun (\r b ->+               R (Fun (\r c ->+                 R (Fun (\r d ->+                   R (Fun (\r e ->+                     R (Fun (\r g ->+                       R (Fun (\r h ->+                         R (Fun (\r i ->+                           R (Fun (\r j ->+                             R (f a b c d e g h i j)+                               (if hidden r +                                  then mkResApp9 r mkNoSrcPos rf (refExp a) +                                         (refExp b) (refExp c) (refExp d) +                                         (refExp e) (refExp g) (refExp h) +                                         (refExp i) (refExp j)+                                  else r)))+                             r))r))r))r))r))r))r))r))rf++cn10 :: (R a1 -> R a2 -> R a3 -> R a4 -> R a5 -> R a6 -> R a7 -> R a8 -> R a9 +         -> R a10 -> b) +     -> RefExp +     -> R (Fun a1 (Fun a2 (Fun a3 (Fun a4 (Fun a5 (Fun a6 (Fun a7 (Fun a8 +          (Fun a9 (Fun a10 b))))))))))+cn10 f rf = R (Fun (\r a ->+              R (Fun (\r b ->+                R (Fun (\r c ->+                  R (Fun (\r d ->+                    R (Fun (\r e ->+                      R (Fun (\r g ->+                        R (Fun (\r h ->+                          R (Fun (\r i ->+                            R (Fun (\r j ->+                              R (Fun (\r k ->+                                R (f a b c d e g h i j k)+                                  (if hidden r +                                    then mkResApp10 r mkNoSrcPos rf (refExp a) +                                           (refExp b) (refExp c) (refExp d) +                                           (refExp e) (refExp g) (refExp h) +                                           (refExp i) (refExp j) (refExp k)+                                    else r)))+                                r))r))r))r))r))r))r))r))r))rf++cn11 :: (R a1 -> R a2 -> R a3 -> R a4 -> R a5 -> R a6 -> R a7 -> R a8 -> R a9 +         -> R a10 -> R a11 -> b) +     -> RefExp +     -> R (Fun a1 (Fun a2 (Fun a3 (Fun a4 (Fun a5 (Fun a6 (Fun a7 (Fun a8 +          (Fun a9 (Fun a10 (Fun a11 b)))))))))))+cn11 f rf = R (Fun (\r a ->+              R (Fun (\r b ->+                R (Fun (\r c ->+                  R (Fun (\r d ->+                    R (Fun (\r e ->+                      R (Fun (\r g ->+                        R (Fun (\r h ->+                          R (Fun (\r i ->+                            R (Fun (\r j ->+                              R (Fun (\r k ->+                                R (Fun (\r l ->+                                  R (f a b c d e g h i j k l)+                                    (if hidden r +                                       then mkResApp11 r mkNoSrcPos rf +                                              (refExp a) (refExp b) (refExp c)+                                              (refExp d) (refExp e) (refExp g)+                                              (refExp h) (refExp i) (refExp j)+                                              (refExp k) (refExp l)+                                        else r)))+                                  r))r))r))r))r))r))r))r))r))r))rf++cn12 :: (R a1 -> R a2 -> R a3 -> R a4 -> R a5 -> R a6 -> R a7 -> R a8 -> R a9 +         -> R a10 -> R a11 -> R a12 -> b) +     -> RefExp +     -> R (Fun a1 (Fun a2 (Fun a3 (Fun a4 (Fun a5 (Fun a6 (Fun a7 (Fun a8 +          (Fun a9 (Fun a10 (Fun a11 (Fun a12 b))))))))))))+cn12 f rf = R (Fun (\r a ->+              R (Fun (\r b ->+                R (Fun (\r c ->+                  R (Fun (\r d ->+                    R (Fun (\r e ->+                      R (Fun (\r g ->+                        R (Fun (\r h ->+                          R (Fun (\r i ->+                            R (Fun (\r j ->+                              R (Fun (\r k ->+                                R (Fun (\r l ->+                                  R (Fun (\r m ->+                                    R (f a b c d e g h i j k l m)+                                      (if hidden r +                                         then mkResApp12 r mkNoSrcPos rf +                                                (refExp a) (refExp b) +                                                (refExp c) (refExp d) +                                                (refExp e) (refExp g)+                                                (refExp h) (refExp i) +                                                (refExp j) (refExp k) +                                                (refExp l) (refExp m)+                                        else r)))+                                    r))r))r))r))r))r))r))r))r))r))r))rf++-- Combinators for constant definitions++constUse :: RefSrcPos -> RefExp -> R a -> R a+constUse sr p wv@(R v rv) =+  let constUseRefExp = mkConstUse p sr rv+  in wrapResult sr constUseRefExp wv+  -- Wrapping only done so that a black hole is correctly located+  -- i.e. to ensure that entering of black hole is marked before+  -- the runtime system notices the black hole.++uconstUse :: RefSrcPos -> RefExp -> R a -> R a+uconstUse sr p wv@(R v rv) =+  if hidden p+    then -- called from trusted code+       wv+    else+       R v (mkConstUse p sr rv)+       -- assume there is no black hole in trusted code++constDef :: RefExp -> RefAtom -> (RefExp -> R a) -> R a+constDef context var f =+  let constDefRefExp = mkConstDef context var+  in wrapResult mkNoSrcPos constDefRefExp (f constDefRefExp)++uconstDef :: RefExp -> RefAtom -> (RefExp -> R a) -> R a+uconstDef context var f =+  if hidden context +    then +      -- do not record local constant+      -- need Forward, because constUse pattern matches on R and+      -- definition of constant may be cyclic, e.g. xs = x:xs.+      uwrapForward context (f context)+    else+      -- ConstDef Exp always recorded; even if not called from traced code+      let constDefRefExp = mkConstDef context var+      in wrapResult mkNoSrcPos constDefRefExp (hide constDefRefExp f)++++-- Combinators for control flow constructs++cguard :: RefSrcPos -> RefExp +       -> R Bool -> (RefExp -> R a) -> (RefExp -> R a) -> R a+cguard sr parent (R c rc) e1 e2 =+  let guardRefExp = mkGuard parent sr rc+  in wrapResult sr guardRefExp (if c then e1 guardRefExp else e2 guardRefExp)++ucguard :: R Bool -> R a -> R a -> R a+-- no wrapForward necessary, because a guard is always surounded by+-- the wrapForward of the function (there is no unevaluated guard).+ucguard (R True _) e1 e2 = e1+ucguard (R False _) e1 e2 = e2++cif :: RefSrcPos -> RefExp +    -> R Bool -> (RefExp -> R a) -> (RefExp -> R a) -> R a+cif sr parent (R c rc) e1 e2 =+  let ifRefExp = mkIf parent sr rc+  in wrapResult sr ifRefExp (if c then e1 ifRefExp else e2 ifRefExp)++ucif :: RefExp -> R Bool -> R a -> R a -> R a+ucif hidden cond e1 e2 = uwrapForward hidden +  (case cond of +    R True _ -> e1+    R False _ -> e2)++ccase :: RefSrcPos -> RefExp -> (R a -> RefExp -> R b) -> R a -> R b+ccase sr parent fun arg@(R _ rarg) =+  let caseRefExp = mkCase parent sr rarg+  in wrapResult sr caseRefExp (fun arg caseRefExp)++uccase :: RefSrcPos -> RefExp -> (R a -> RefExp -> R b) -> R a -> R b+uccase _ hidden fun arg = uwrapForward hidden (fun arg hidden) ++-- Combinators for field updating++-- wraps a data constructor or data constructor application,+-- recording the correct expression in the trace.+-- Instance generated for every data type by tracing transformation.+class WrapVal a where+  wrapVal :: RefSrcPos -> a -> RefExp -> R a++update1 :: WrapVal a => RefSrcPos -> RefExp -> R a -> (a -> a) +        -> RefAtom -> R b -> R a+update1 sr p (R v rv) modify f1 (R _ r1) =+  let p' = mkFieldUpdate1 p sr rv f1 r1+  in wrapResult sr p' (wrapVal sr (modify v) p')++update2 :: WrapVal a => RefSrcPos -> RefExp -> R a -> (a -> a) +        -> RefAtom -> RefAtom -> R b -> R c -> R a+update2 sr p (R v rv) modify f1 f2 (R _ r1) (R _ r2) =+  let p' = mkFieldUpdate2 p sr rv f1 r1 f2 r2+  in wrapResult sr p' (wrapVal sr (modify v) p')++update3 :: WrapVal a => RefSrcPos -> RefExp -> R a -> (a -> a) +        -> RefAtom -> RefAtom -> RefAtom -> R b -> R c -> R d -> R a+update3 sr p (R v rv) modify f1 f2 f3 (R _ r1) (R _ r2) (R _ r3) =+  let p' = mkFieldUpdate3 p sr rv f1 r1 f2 r2 f3 r3+  in wrapResult sr p' (wrapVal sr (modify v) p')++update4 :: WrapVal a => RefSrcPos -> RefExp -> R a -> (a -> a) +        -> RefAtom -> RefAtom -> RefAtom -> RefAtom+        -> R b -> R c -> R d -> R e -> R a+update4 sr p (R v rv) modify f1 f2 f3 f4 (R _ r1) (R _ r2) (R _ r3) (R _ r4) =+  let p' = mkFieldUpdate4 p sr rv f1 r1 f2 r2 f3 r3 f4 r4+  in wrapResult sr p' (wrapVal sr (modify v) p')++update5 :: WrapVal a => RefSrcPos -> RefExp -> R a -> (a -> a) +        -> RefAtom -> RefAtom -> RefAtom -> RefAtom -> RefAtom+        -> R b -> R c -> R d -> R e -> R f -> R a+update5 sr p (R v rv) modify f1 f2 f3 f4 f5+        (R _ r1) (R _ r2) (R _ r3) (R _ r4) (R _ r5) =+  let p' = mkFieldUpdate5 p sr rv f1 r1 f2 r2 f3 r3 f4 r4 f5 r5+  in wrapResult sr p' (wrapVal sr (modify v) p')++update6 :: WrapVal a => RefSrcPos -> RefExp -> R a -> (a -> a) +        -> RefAtom -> RefAtom -> RefAtom -> RefAtom -> RefAtom -> RefAtom+        -> R b -> R c -> R d -> R e -> R f -> R g -> R a+update6 sr p (R v rv) modify f1 f2 f3 f4 f5 f6+        (R _ r1) (R _ r2) (R _ r3) (R _ r4) (R _ r5) (R _ r6) =+  let p' = mkFieldUpdate6 p sr rv f1 r1 f2 r2 f3 r3 f4 r4 f5 r5 f6 r6+  in wrapResult sr p' (wrapVal sr (modify v) p')++update7 :: WrapVal a => RefSrcPos -> RefExp -> R a -> (a -> a) +        -> RefAtom -> RefAtom -> RefAtom -> RefAtom -> RefAtom+        -> RefAtom -> RefAtom+        -> R b -> R c -> R d -> R e -> R f -> R g -> R h -> R a+update7 sr p (R v rv) modify f1 f2 f3 f4 f5 f6 f7+        (R _ r1) (R _ r2) (R _ r3) (R _ r4) (R _ r5) (R _ r6) (R _ r7) =+  let p' = mkFieldUpdate7 p sr rv f1 r1 f2 r2 f3 r3 f4 r4 f5 r5 f6 r6 f7 r7+  in wrapResult sr p' (wrapVal sr (modify v) p')++update8 :: WrapVal a => RefSrcPos -> RefExp -> R a -> (a -> a) +        -> RefAtom -> RefAtom -> RefAtom -> RefAtom -> RefAtom+        -> RefAtom -> RefAtom -> RefAtom+        -> R b -> R c -> R d -> R e -> R f -> R g -> R h -> R i -> R a+update8 sr p (R v rv) modify f1 f2 f3 f4 f5 f6 f7 f8+        (R _ r1) (R _ r2) (R _ r3) (R _ r4) (R _ r5) (R _ r6)+        (R _ r7) (R _ r8) =+  let p' = mkFieldUpdate8 p sr rv f1 r1 f2 r2 f3 r3 f4 r4 f5 r5+                                  f6 r6 f7 r7 f8 r8+  in wrapResult sr p' (wrapVal sr (modify v) p')++update9 :: WrapVal a => RefSrcPos -> RefExp -> R a -> (a -> a) +        -> RefAtom -> RefAtom -> RefAtom -> RefAtom -> RefAtom+        -> RefAtom -> RefAtom -> RefAtom -> RefAtom+        -> R b -> R c -> R d -> R e -> R f -> R g -> R h -> R i -> R j -> R a+update9 sr p (R v rv) modify f1 f2 f3 f4 f5 f6 f7 f8 f9+        (R _ r1) (R _ r2) (R _ r3) (R _ r4) (R _ r5) (R _ r6)+        (R _ r7) (R _ r8) (R _ r9) =+  let p' = mkFieldUpdate9 p sr rv f1 r1 f2 r2 f3 r3 f4 r4 f5 r5+                                  f6 r6 f7 r7 f8 r8 f9 r9+  in wrapResult sr p' (wrapVal sr (modify v) p')++update10 :: WrapVal a => RefSrcPos -> RefExp -> R a -> (a -> a) +        -> RefAtom -> RefAtom -> RefAtom -> RefAtom -> RefAtom+        -> RefAtom -> RefAtom -> RefAtom -> RefAtom -> RefAtom+        -> R b -> R c -> R d -> R e -> R f -> R g -> R h -> R i -> R j -> R k+        -> R a+update10 sr p (R v rv) modify f1 f2 f3 f4 f5 f6 f7 f8 f9 f10+        (R _ r1) (R _ r2) (R _ r3) (R _ r4) (R _ r5) (R _ r6)+        (R _ r7) (R _ r8) (R _ r9) (R _ r10) =+  let p' = mkFieldUpdate10 p sr rv f1 r1 f2 r2 f3 r3 f4 r4 f5 r5+                                   f6 r6 f7 r7 f8 r8 f9 r9 f10 r10+  in wrapResult sr p' (wrapVal sr (modify v) p')++-- ...++uupdate :: WrapVal a => RefExp -> R a -> (a -> a) -> R a+uupdate h (R v rv) modify = uwrapForward h (wrapVal mkNoSrcPos (modify v) h)+++-- Combinator for projection (lambda-bound var in projective context)++projection :: RefSrcPos -> RefExp -> R a -> R a+projection sr p (R v rv) = R v (mkProjection p sr rv)++-- Combinators for literals++conChar :: RefSrcPos -> RefExp -> Char -> R Char+conChar sr p c = R c (mkChar p sr c)++conInteger :: RefSrcPos -> RefExp -> Integer -> R Integer+conInteger sr p i = +  R i (if Prelude.toInteger (minBound::Int) <= i && +          i <= Prelude.toInteger (maxBound::Int) +         then mkInt p sr (Prelude.fromInteger i) +         else mkInteger p sr (show i))++mkAtomRational :: RefSrcPos -> RefExp -> Rational -> RefExp+mkAtomRational sr p r =+  if Prelude.toInteger (minBound::Int) <= num && +     num <= Prelude.toInteger (maxBound::Int) &&+     Prelude.toInteger (minBound::Int) <= denom && +     denom <= Prelude.toInteger (maxBound::Int)+    then mkRat p sr (Prelude.fromInteger num) (Prelude.fromInteger denom)+    else mkRational p sr (show num) (show denom)+  where+  num = numerator r+  denom = denominator r++-- conRational undefinable+-- because original and transformed Rational are different++fromExpList :: RefSrcPos -> RefExp -> [R a] -> R (List a)+fromExpList sr h xs = +  foldr (\y ys -> con2 sr h Cons aCons y ys) (con0 sr h List aList) xs++fromLitString :: RefSrcPos -> RefExp -> Prelude.String -> R (List Char)+fromLitString sr h xs = +  foldr (\x xs -> con2 sr h Cons aCons (conChar sr h x) xs) +    (con0 sr h List aList) xs+++-- Create node directly with result+-- (to do: create efficient direct C-functions)++mkResApp2 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +mkResApp2 p sr f a1 a2 = +  let ra = mkApp2 p sr f a1 a2+  in entResult ra sr `seq` resResult ra ra sr `seq` ra ++mkResApp3 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +          -> RefExp +mkResApp3 p sr f a1 a2 a3 = +  let ra = mkApp3 p sr f a1 a2 a3+  in entResult ra sr `seq` resResult ra ra sr `seq` ra ++mkResApp4 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +          -> RefExp -> RefExp +mkResApp4 p sr f a1 a2 a3 a4 = +  let ra = mkApp4 p sr f a1 a2 a3 a4+  in entResult ra sr `seq` resResult ra ra sr `seq` ra ++mkResApp5 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +          -> RefExp -> RefExp -> RefExp +mkResApp5 p sr f a1 a2 a3 a4 a5 = +  let ra = mkApp5 p sr f a1 a2 a3 a4 a5+  in entResult ra sr `seq` resResult ra ra sr `seq` ra ++mkResApp6 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +          -> RefExp -> RefExp -> RefExp -> RefExp +mkResApp6 p sr f a1 a2 a3 a4 a5 a6 = +  let ra = mkApp6 p sr f a1 a2 a3 a4 a5 a6+  in entResult ra sr `seq` resResult ra ra sr `seq` ra ++mkResApp7 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +          -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp +mkResApp7 p sr f a1 a2 a3 a4 a5 a6 a7 = +  let ra = mkApp7 p sr f a1 a2 a3 a4 a5 a6 a7+  in entResult ra sr `seq` resResult ra ra sr `seq` ra ++mkResApp8 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +          -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp +mkResApp8 p sr f a1 a2 a3 a4 a5 a6 a7 a8 = +  let ra = mkApp8 p sr f a1 a2 a3 a4 a5 a6 a7 a8+  in entResult ra sr `seq` resResult ra ra sr `seq` ra ++mkResApp9 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +          -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp  +          -> RefExp +mkResApp9 p sr f a1 a2 a3 a4 a5 a6 a7 a8 a9 = +  let ra = mkApp9 p sr f a1 a2 a3 a4 a5 a6 a7 a8 a9+  in entResult ra sr `seq` resResult ra ra sr `seq` ra ++mkResApp10 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +             -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp +             -> RefExp -> RefExp+mkResApp10 p sr f a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 = +  let ra = mkApp10 p sr f a1 a2 a3 a4 a5 a6 a7 a8 a9 a10+  in entResult ra sr `seq` resResult ra ra sr `seq` ra ++mkResApp11 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +             -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp +             -> RefExp -> RefExp -> RefExp+mkResApp11 p sr f a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 = +  let ra = mkApp11 p sr f a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11+  in entResult ra sr `seq` resResult ra ra sr `seq` ra ++mkResApp12 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +             -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp +             -> RefExp -> RefExp -> RefExp -> RefExp+mkResApp12 p sr f a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 = +  let ra = mkApp12 p sr f a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12+  in entResult ra sr `seq` resResult ra ra sr `seq` ra ++mkResApp13 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +             -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp +             -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp+mkResApp13 p sr f a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 = +  let ra = mkApp13 p sr f a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13+  in entResult ra sr `seq` resResult ra ra sr `seq` ra ++mkResApp14 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +             -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp +             -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp+mkResApp14 p sr f a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 = +  let ra = mkApp14 p sr f a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14+  in entResult ra sr `seq` resResult ra ra sr `seq` ra ++mkResApp15 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +             -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp +             -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp +             -> RefExp+mkResApp15 p sr f a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 = +  let ra = mkApp15 p sr f a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15+  in entResult ra sr `seq` resResult ra ra sr `seq` ra +++-- optimising combinators for application of functions of known arity++-- traced function in traced or trusted application+app1 :: RefSrcPos -> RefSrcPos -> RefExp -> RefAtom +     -> (R a -> RefExp -> R z) -> R a -> R z+app1 sr srFun p af hf a@(R _ ra) =+  let rf = mkValueUse p srFun af+      r = mkApp1 p sr rf ra+  in wrapResult sr r (hf a r)++app2 :: RefSrcPos -> RefSrcPos -> RefExp -> RefAtom +     -> (R a -> R b -> RefExp -> R z) -> R a -> R b -> R z+app2 sr srFun p af hf a@(R _ ra) b@(R _ rb) =+  let rf = mkValueUse p srFun af+      r = mkApp2 p sr rf ra rb+  in wrapResult sr r (hf a b r)++app3 :: RefSrcPos -> RefSrcPos -> RefExp -> RefAtom +     -> (R a -> R b -> R c -> RefExp -> R z) -> R a -> R b -> R c -> R z+app3 sr srFun p af hf a@(R _ ra) b@(R _ rb) c@(R _ rc) =+  let rf = mkValueUse p srFun af+      r = mkApp3 p sr rf ra rb rc+  in wrapResult sr r (hf a b c r)++app4 :: RefSrcPos -> RefSrcPos -> RefExp -> RefAtom +     -> (R a -> R b -> R c -> R d -> RefExp -> R z) +     -> R a -> R b -> R c -> R d -> R z+app4 sr srFun p af hf a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) =+  let rf = mkValueUse p srFun af+      r = mkApp4 p sr rf ra rb rc rd+  in wrapResult sr r (hf a b c d r)++app5 :: RefSrcPos -> RefSrcPos -> RefExp -> RefAtom +     -> (R a -> R b -> R c -> R d -> R e -> RefExp -> R z) +     -> R a -> R b -> R c -> R d -> R e -> R z+app5 sr srFun p af hf a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) e@(R _ re) =+  let rf = mkValueUse p srFun af+      r = mkApp5 p sr rf ra rb rc rd re+  in wrapResult sr r (hf a b c d e r)++-- trusted function in traced application+uapp1 :: RefSrcPos -> RefSrcPos -> RefExp -> RefAtom +      -> (R a -> RefExp -> R z) -> R a -> R z+uapp1 sr srFun p af hf a@(R _ ra) =+  let rf = mkValueUse p srFun af+      r = mkApp1 p sr rf ra +      h = mkHidden r+  in wrapResult sr r (wrapResult mkNoSrcPos h (hf a h))++uapp2 :: RefSrcPos -> RefSrcPos -> RefExp -> RefAtom +      -> (R a -> R b -> RefExp -> R z) -> R a -> R b -> R z+uapp2 sr srFun p af hf a@(R _ ra) b@(R _ rb) =+  let rf = mkValueUse p srFun af+      r = mkApp2 p sr rf ra rb+      h = mkHidden r+  in wrapResult sr r (wrapResult mkNoSrcPos h (hf a b h))++uapp3 :: RefSrcPos -> RefSrcPos -> RefExp -> RefAtom +      -> (R a -> R b -> R c -> RefExp -> R z) -> R a -> R b -> R c -> R z+uapp3 sr srFun p af hf a@(R _ ra) b@(R _ rb) c@(R _ rc) =+  let rf = mkValueUse p srFun af+      r = mkApp3 p sr rf ra rb rc+      h = mkHidden r+  in wrapResult sr r (wrapResult mkNoSrcPos h (hf a b c h))++uapp4 :: RefSrcPos -> RefSrcPos -> RefExp -> RefAtom +      -> (R a -> R b -> R c -> R d -> RefExp -> R z) +      -> R a -> R b -> R c -> R d -> R z+uapp4 sr srFun p af hf a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) =+  let rf = mkValueUse p srFun af+      r = mkApp4 p sr rf ra rb rc rd+      h = mkHidden r+  in wrapResult sr r (wrapResult mkNoSrcPos h (hf a b c d h))++uapp5 :: RefSrcPos -> RefSrcPos -> RefExp -> RefAtom +      -> (R a -> R b -> R c -> R d -> R e -> RefExp -> R z) +      -> R a -> R b -> R c -> R d -> R e -> R z+uapp5 sr srFun p af hf a@(R _ ra) b@(R _ rb) c@(R _ rc) d@(R _ rd) e@(R _ re) =+  let rf = mkValueUse p srFun af+      r = mkApp5 p sr rf ra rb rc rd re+      h = mkHidden r+  in wrapResult sr r (wrapResult mkNoSrcPos h (hf a b c d e h))++-- for trusted function in trusted application no new combinator++-- ---------------------------------------------------------------------------+-- Interface to foreign C-functions for writing the ART trace.++openTrace :: String -> Prelude.IO ()+openTrace progname = withCString progname openTrace'++FOREIGN("hat-c.h hat_Open")+  openTrace' :: CString -> Prelude.IO ()++FOREIGN("hat-c.h hat_Close")+  closeTrace :: Prelude.IO ()++hatAborted :: String -> Prelude.IO ()+hatAborted msg = withCString msg hatAbort'++FOREIGN("hat-c.h hat_Abort")+  hatAbort' :: CString -> Prelude.IO ()++errorTraceExit :: String -> RefExp -> Int -> ()+errorTraceExit msg ref no = +  unsafePerformIO $+    withCString msg (\msg'->errorTraceExit' msg' ref no)++FOREIGN("hat-c.h hat_ErrorExit")+  errorTraceExit' :: CString -> RefExp -> Int -> Prelude.IO ()++outputTrace :: RefExp -> String -> Prelude.IO ()+outputTrace trace output = withCString output (outputTrace' trace)++FOREIGN("hat-c.h hat_OutputTrace")+  outputTrace' :: RefExp -> CString -> Prelude.IO ()++FOREIGN("hat-c.h hat_Hidden")+  hidden :: RefExp -> Bool++FOREIGN("hat-c.h mkRoot")+  mkRoot :: RefExp++mkModule :: String -> String -> Bool -> RefModule+mkModule modName srcFile traced = +  unsafePerformIO $+    withCString modName (\modName' ->+    withCString srcFile (\srcFile' ->+      mkModule' modName' srcFile' traced))++FOREIGN("hat-c.h mkModule")+  mkModule' :: CString -> CString -> Bool -> Prelude.IO RefModule++FOREIGN("hat-c.h mkSrcPos")+  mkSrcPos :: RefModule -> Loc -> Loc -> RefSrcPos++-- Exp nodes++FOREIGN("hat-c.h mkResApp1")+  mkResApp1 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp++FOREIGN("hat-c.h mkApp1")+  mkApp1 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp++FOREIGN("hat-c.h mkApp2")+  mkApp2 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp++FOREIGN("hat-c.h mkApp3")+  mkApp3 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +         -> RefExp++FOREIGN("hat-c.h mkApp4")+  mkApp4 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +         -> RefExp -> RefExp++FOREIGN("hat-c.h mkApp5")+  mkApp5 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +         -> RefExp -> RefExp -> RefExp++FOREIGN("hat-c.h mkApp6")+  mkApp6 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +         -> RefExp -> RefExp -> RefExp -> RefExp++FOREIGN("hat-c.h mkApp7")+  mkApp7 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +         -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp++FOREIGN("hat-c.h mkApp8")+  mkApp8 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +         -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp++FOREIGN("hat-c.h mkApp9")+  mkApp9 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +         -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp++FOREIGN("hat-c.h mkApp10")+  mkApp10 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +          -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp+          -> RefExp++FOREIGN("hat-c.h mkApp11")+  mkApp11 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +          -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp+          -> RefExp -> RefExp++FOREIGN("hat-c.h mkApp12")+  mkApp12 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +          -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp+          -> RefExp -> RefExp -> RefExp++FOREIGN("hat-c.h mkApp13")+  mkApp13 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +          -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp+          -> RefExp -> RefExp -> RefExp -> RefExp++FOREIGN("hat-c.h mkApp14")+  mkApp14 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +          -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp+          -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp++FOREIGN("hat-c.h mkApp15")+  mkApp15 :: RefExp -> RefSrcPos -> RefExp -> RefExp -> RefExp -> RefExp +          -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp+          -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp++FOREIGN("hat-c.h mkValueApp1")+  mkValueApp1 :: RefExp -> RefSrcPos -> RefAtom -> RefExp -> RefExp++FOREIGN("hat-c.h mkValueApp2")+  mkValueApp2 :: RefExp -> RefSrcPos -> RefAtom -> RefExp -> RefExp -> RefExp++FOREIGN("hat-c.h mkValueApp3")+  mkValueApp3 :: RefExp -> RefSrcPos -> RefAtom -> RefExp -> RefExp -> RefExp +         -> RefExp++FOREIGN("hat-c.h mkValueApp4")+  mkValueApp4 :: RefExp -> RefSrcPos -> RefAtom -> RefExp -> RefExp -> RefExp +         -> RefExp -> RefExp++FOREIGN("hat-c.h mkValueApp5")+  mkValueApp5 :: RefExp -> RefSrcPos -> RefAtom -> RefExp -> RefExp -> RefExp +         -> RefExp -> RefExp -> RefExp++FOREIGN("hat-c.h mkValueApp6")+  mkValueApp6 :: RefExp -> RefSrcPos -> RefAtom -> RefExp -> RefExp -> RefExp +         -> RefExp -> RefExp -> RefExp -> RefExp++FOREIGN("hat-c.h mkValueApp7")+  mkValueApp7 :: RefExp -> RefSrcPos -> RefAtom -> RefExp -> RefExp -> RefExp +         -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp++FOREIGN("hat-c.h mkValueApp8")+  mkValueApp8 :: RefExp -> RefSrcPos -> RefAtom -> RefExp -> RefExp -> RefExp +         -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp++FOREIGN("hat-c.h mkValueApp9")+  mkValueApp9 :: RefExp -> RefSrcPos -> RefAtom -> RefExp -> RefExp -> RefExp +         -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp++FOREIGN("hat-c.h mkValueApp10")+  mkValueApp10 :: RefExp -> RefSrcPos -> RefAtom -> RefExp -> RefExp -> RefExp +         -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp+         -> RefExp++FOREIGN("hat-c.h mkValueApp11")+  mkValueApp11 :: RefExp -> RefSrcPos -> RefAtom -> RefExp -> RefExp -> RefExp +         -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp+         -> RefExp -> RefExp++FOREIGN("hat-c.h mkValueApp12")+  mkValueApp12 :: RefExp -> RefSrcPos -> RefAtom -> RefExp -> RefExp -> RefExp +         -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp+         -> RefExp -> RefExp -> RefExp++FOREIGN("hat-c.h mkValueApp13")+  mkValueApp13 :: RefExp -> RefSrcPos -> RefAtom -> RefExp -> RefExp -> RefExp +         -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp+         -> RefExp -> RefExp -> RefExp -> RefExp++FOREIGN("hat-c.h mkValueApp14")+  mkValueApp14 :: RefExp -> RefSrcPos -> RefAtom -> RefExp -> RefExp -> RefExp +         -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp+         -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp++FOREIGN("hat-c.h mkValueApp15")+  mkValueApp15 :: RefExp -> RefSrcPos -> RefAtom -> RefExp -> RefExp -> RefExp +         -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp+         -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp -> RefExp++FOREIGN("hat-c.h mkChar")+  mkChar :: RefExp -> RefSrcPos -> Char -> RefExp++FOREIGN("hat-c.h mkInt")+  mkInt :: RefExp -> RefSrcPos -> Int -> RefExp++mkInteger :: RefExp -> RefSrcPos -> String -> RefExp+mkInteger parent use integer = +  unsafePerformIO $+    withCString integer (\integer' -> mkInteger' parent use integer')++FOREIGN("hat-c.h mkInteger")+  mkInteger' :: RefExp -> RefSrcPos -> CString -> Prelude.IO RefExp++FOREIGN("hat-c.h mkRat")+  mkRat :: RefExp -> RefSrcPos -> Int -> Int -> RefExp++mkRational :: RefExp -> RefSrcPos -> String -> String -> RefExp+mkRational parent use num denom = +  unsafePerformIO $+    withCString num (\num' ->+    withCString denom (\denom' -> mkRational' parent use num' denom'))++FOREIGN("hat-c.h mkRational")+  mkRational' :: RefExp -> RefSrcPos -> CString -> CString -> Prelude.IO RefExp++FOREIGN("hat-c.h mkFloat")+  mkFloat :: RefExp -> RefSrcPos -> Float -> RefExp++FOREIGN("hat-c.h mkDouble")+  mkDouble :: RefExp -> RefSrcPos -> Double -> RefExp++FOREIGN("hat-c.h mkValueUse")+  mkValueUse :: RefExp -> RefSrcPos -> RefAtom -> RefExp++FOREIGN("hat-c.h mkConstUse")+  mkConstUse :: RefExp -> RefSrcPos -> RefExp -> RefExp++FOREIGN("hat-c.h mkConstDef")+  mkConstDef :: RefExp -> RefAtom -> RefExp++FOREIGN("hat-c.h mkGuard")+  mkGuard :: RefExp -> RefSrcPos -> RefExp -> RefExp++FOREIGN("hat-c.h mkCase")+  mkCase :: RefExp -> RefSrcPos -> RefExp -> RefExp++FOREIGN("hat-c.h mkIf")+  mkIf :: RefExp -> RefSrcPos -> RefExp -> RefExp++FOREIGN("hat-c.h mkFieldUpdate1")+  mkFieldUpdate1 :: RefExp -> RefSrcPos -> RefExp+                 -> RefAtom -> RefExp +                 -> RefExp++FOREIGN("hat-c.h mkFieldUpdate2")+  mkFieldUpdate2 :: RefExp -> RefSrcPos -> RefExp+                 -> RefAtom -> RefExp -> RefAtom -> RefExp+                 -> RefExp++FOREIGN("hat-c.h mkFieldUpdate3")+  mkFieldUpdate3 :: RefExp -> RefSrcPos -> RefExp+                 -> RefAtom -> RefExp -> RefAtom -> RefExp -> RefAtom -> RefExp+                 -> RefExp++FOREIGN("hat-c.h mkFieldUpdate4")+  mkFieldUpdate4 :: RefExp -> RefSrcPos -> RefExp+                 -> RefAtom -> RefExp -> RefAtom -> RefExp+                 -> RefAtom -> RefExp -> RefAtom -> RefExp+                 -> RefExp++FOREIGN("hat-c.h mkFieldUpdate5")+  mkFieldUpdate5 :: RefExp -> RefSrcPos -> RefExp+                 -> RefAtom -> RefExp -> RefAtom -> RefExp+                 -> RefAtom -> RefExp -> RefAtom -> RefExp -> RefAtom -> RefExp+                 -> RefExp++FOREIGN("hat-c.h mkFieldUpdate6")+  mkFieldUpdate6 :: RefExp -> RefSrcPos -> RefExp+                 -> RefAtom -> RefExp -> RefAtom -> RefExp -> RefAtom -> RefExp+                 -> RefAtom -> RefExp -> RefAtom -> RefExp -> RefAtom -> RefExp+                 -> RefExp++FOREIGN("hat-c.h mkFieldUpdate7")+  mkFieldUpdate7 :: RefExp -> RefSrcPos -> RefExp+                 -> RefAtom -> RefExp -> RefAtom -> RefExp -> RefAtom -> RefExp+                 -> RefAtom -> RefExp -> RefAtom -> RefExp -> RefAtom -> RefExp+                 -> RefAtom -> RefExp+                 -> RefExp++FOREIGN("hat-c.h mkFieldUpdate8")+  mkFieldUpdate8 :: RefExp -> RefSrcPos -> RefExp+                 -> RefAtom -> RefExp -> RefAtom -> RefExp -> RefAtom -> RefExp+                 -> RefAtom -> RefExp -> RefAtom -> RefExp -> RefAtom -> RefExp+                 -> RefAtom -> RefExp -> RefAtom -> RefExp+                 -> RefExp++FOREIGN("hat-c.h mkFieldUpdate9")+  mkFieldUpdate9 :: RefExp -> RefSrcPos -> RefExp+                 -> RefAtom -> RefExp -> RefAtom -> RefExp -> RefAtom -> RefExp+                 -> RefAtom -> RefExp -> RefAtom -> RefExp -> RefAtom -> RefExp+                 -> RefAtom -> RefExp -> RefAtom -> RefExp -> RefAtom -> RefExp+                 -> RefExp++FOREIGN("hat-c.h mkFieldUpdate10")+  mkFieldUpdate10 :: RefExp -> RefSrcPos -> RefExp+                 -> RefAtom -> RefExp -> RefAtom -> RefExp -> RefAtom -> RefExp+                 -> RefAtom -> RefExp -> RefAtom -> RefExp -> RefAtom -> RefExp+                 -> RefAtom -> RefExp -> RefAtom -> RefExp -> RefAtom -> RefExp+                 -> RefAtom -> RefExp+                 -> RefExp++FOREIGN("hat-c.h mkProjection")+  mkProjection :: RefExp -> RefSrcPos -> RefExp -> RefExp++FOREIGN("hat-c.h mkHidden")+  mkHidden :: RefExp -> RefExp++FOREIGN("hat-c.h mkForward")+  mkForward :: RefExp -> RefExp++FOREIGN("hat-c.h mkDoStmt")+  mkDoStmt :: RefExp -> RefExp++FOREIGN("hat-c.h mkLambda")+  mkLambda :: RefAtom++FOREIGN("hat-c.h mkDoLambda")+  mkDoLambda :: RefAtom++mkVariable :: RefModule -> Loc -> Loc -> Fixity -> Arity -> String +           -> Bool -> RefAtom+mkVariable mod begin end fixity arity name local =+  unsafePerformIO $+    withCString name +      (\name' -> mkVariable' mod begin end fixity arity name' local)++FOREIGN("hat-c.h mkVariable")+  mkVariable' :: RefModule -> Loc -> Loc -> Fixity -> Arity -> CString -> Bool +              -> Prelude.IO RefAtom++mkConstructor :: RefModule -> Loc -> Loc -> Fixity -> Arity +              -> String -> RefAtom+mkConstructor mod begin end fixity arity name =+  unsafePerformIO $+    withCString name +      (\name' -> mkConstructor' mod begin end fixity arity name')++FOREIGN("hat-c.h mkConstructor")+  mkConstructor' :: RefModule -> Loc -> Loc -> Fixity -> Arity -> CString +                 -> Prelude.IO RefAtom++mkConstructorWFields :: RefModule -> Loc -> Loc -> Fixity -> Arity -> String+                     -> [RefAtom] -> RefAtom+mkConstructorWFields mod begin end fixity arity name labels =+  unsafePerformIO $+    withCString name (\name' ->+    withArray (map (\(RA i) -> i) labels) (\labels' ->+      mkConstructorWFields' mod begin end fixity arity name' labels'))++FOREIGN("hat-c.h mkConstructorWFields")+  mkConstructorWFields' :: RefModule -> Loc -> Loc -> Fixity -> Arity +                        -> CString -> Ptr Int -> Prelude.IO RefAtom++mkAbstract :: String -> RefAtom+mkAbstract txt = unsafePerformIO $+  withCString txt (\txt' -> mkAbstract' txt')++FOREIGN("hat-c.h mkAbstract")+  mkAbstract' :: CString -> Prelude.IO RefAtom++-- Update node that it was entered++FOREIGN("hat-c.h entResult")+  entResult :: RefExp -> RefSrcPos -> ()++FOREIGN("hat-c.h entForward")+  entForward :: RefExp -> RefExp -> ()++-- Update node with result++FOREIGN("hat-c.h resResult")+  resResult :: RefExp -> RefExp -> RefSrcPos -> ()++FOREIGN("hat-c.h resForward")+  resForward :: RefExp -> RefExp -> ()++FOREIGN("hat-c.h recordChild")+  recordChild :: RefExp -> RefExp -> ()++-- ----------------------------------------------------------------------------+-- End
+ Hat/IO.hs view
@@ -0,0 +1,657 @@+module Hat.IO+  (Handle(),HandlePosn(),IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode)+    ,aReadMode,aWriteMode,aAppendMode,aReadWriteMode,BufferMode(NoBuffering+      ,LineBuffering,BlockBuffering),aNoBuffering,aLineBuffering,aBlockBuffering+    ,SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),aAbsoluteSeek,aRelativeSeek+    ,aSeekFromEnd,gstdin,gstdout,gstderr,gopenFile,aopenFile,hopenFile,ghClose+    ,ahClose,hhClose,ghFileSize,ahFileSize,hhFileSize,ghIsEOF,ahIsEOF,hhIsEOF+    ,gisEOF,ghSetBuffering,ahSetBuffering,hhSetBuffering,ghGetBuffering+    ,ahGetBuffering,hhGetBuffering,ghFlush,ahFlush,hhFlush,ghGetPosn,ahGetPosn+    ,hhGetPosn,ghSetPosn,ahSetPosn,hhSetPosn,ghSeek,ahSeek,hhSeek,ghWaitForInput+    ,ahWaitForInput,hhWaitForInput,ghReady,ahReady,hhReady,ghGetChar,ahGetChar+    ,hhGetChar,ghGetLine,ahGetLine,hhGetLine,ghLookAhead,ahLookAhead,hhLookAhead+    ,ghGetContents,ahGetContents,hhGetContents,ghPutChar,ahPutChar,hhPutChar+    ,ghPutStr,ahPutStr,hhPutStr,ghPutStrLn,ahPutStrLn,hhPutStrLn,ghPrint,ahPrint+    ,hhPrint,ghIsOpen,ahIsOpen,hhIsOpen,ghIsClosed,ahIsClosed,hhIsClosed+    ,ghIsReadable,ahIsReadable,hhIsReadable,ghIsWritable,ahIsWritable+    ,hhIsWritable,ghIsSeekable,ahIsSeekable,hhIsSeekable,gisAlreadyExistsError+    ,aisAlreadyExistsError,hisAlreadyExistsError,gisDoesNotExistError+    ,aisDoesNotExistError,hisDoesNotExistError,gisAlreadyInUseError+    ,aisAlreadyInUseError,hisAlreadyInUseError,gisFullError,aisFullError+    ,hisFullError,gisEOFError,aisEOFError,hisEOFError,gisIllegalOperation+    ,aisIllegalOperation,hisIllegalOperation,gisPermissionError+    ,aisPermissionError,hisPermissionError,gisUserError,aisUserError+    ,hisUserError,gioeGetErrorString,aioeGetErrorString,hioeGetErrorString+    ,gioeGetHandle,aioeGetHandle,hioeGetHandle,gioeGetFileName,aioeGetFileName+    ,hioeGetFileName,gtry,atry,htry,gbracket,abracket,hbracket,gbracket_+    ,abracket_,hbracket_,IO(),FilePath(),IOError(),gioError,aioError,hioError+    ,guserError,auserError,huserError,gcatch,acatch,hcatch,ginteract,ainteract+    ,hinteract,gputChar,aputChar,hputChar,gputStr,aputStr,hputStr,gputStrLn+    ,aputStrLn,hputStrLn,gprint,aprint,hprint,ggetChar,ggetLine,ggetContents+    ,greadFile,areadFile,hreadFile,gwriteFile,awriteFile,hwriteFile,gappendFile+    ,aappendFile,happendFile,greadIO,areadIO,hreadIO,greadLn) where++import qualified Hat.PreludeBasic +import qualified Prelude +import Hat.Hack +import qualified Hat.Hat as T +import Hat.Hat  (WrapVal(wrapVal))+import Hat.Prelude +import Hat.Ix  (Ix(grange,gindex,ginRange,srange,sindex,sinRange))+import Hat.PreludeBuiltinTypes +import System.IO  (Handle(),HandlePosn())+import qualified System.IO as IO +import qualified System.IO.Error as Error +import Hat.IOBuiltinTypes +import Hat.IOBuiltin ++gprimHandleEq ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Handle (T.Fun Handle Bool))++gprimHandleEq pprimHandleEq p =+  T.ufun2 aprimHandleEq pprimHandleEq p hprimHandleEq++hprimHandleEq z1primHandleEq z2primHandleEq kprimHandleEq =+  fromBool kprimHandleEq+    ((toHandle kprimHandleEq z1primHandleEq)+      Prelude.==+      (toHandle kprimHandleEq z2primHandleEq))++gprimHandleShowsPrec ::+  T.RefSrcPos ->+    T.RefExp -> T.R (T.Fun Int (T.Fun Handle (T.Fun String String)))++gprimHandleShowsPrec pprimHandleShowsPrec p =+  T.ufun3 aprimHandleShowsPrec pprimHandleShowsPrec p hprimHandleShowsPrec++hprimHandleShowsPrec z1primHandleShowsPrec z2primHandleShowsPrec+  z3primHandleShowsPrec kprimHandleShowsPrec =+  fromString kprimHandleShowsPrec+    (Prelude.showsPrec (T.toInt kprimHandleShowsPrec z1primHandleShowsPrec)+      (toHandle kprimHandleShowsPrec z2primHandleShowsPrec)+      (toString kprimHandleShowsPrec z3primHandleShowsPrec))++instance Eq (Handle)+  where+  +  (!==) (%==) p = T.uconstUse (%==) p (|==)+  +  (|==) =+    T.uconstDef T.mkRoot (+&%=&=&%=$#==) (\ p -> gprimHandleEq T.mkNoSrcPos p)+  ++instance Show (Handle)+  where+  +  gshowsPrec pshowsPrec p = T.uconstUse pshowsPrec p sshowsPrec+  +  sshowsPrec =+    T.uconstDef T.mkRoot a46v3v46v33showsPrec+      (\ p -> gprimHandleShowsPrec T.mkNoSrcPos p)+  ++gprimHandlePosnEq ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun HandlePosn (T.Fun HandlePosn Bool))++gprimHandlePosnEq pprimHandlePosnEq p =+  T.ufun2 aprimHandlePosnEq pprimHandlePosnEq p hprimHandlePosnEq++hprimHandlePosnEq z1primHandlePosnEq z2primHandlePosnEq kprimHandlePosnEq =+  fromBool kprimHandlePosnEq+    ((toHandlePosn kprimHandlePosnEq z1primHandlePosnEq)+      Prelude.==+      (toHandlePosn kprimHandlePosnEq z2primHandlePosnEq))++instance Eq (HandlePosn)+  where+  +  (!==) (%==) p = T.uconstUse (%==) p (|==)+  +  (|==) =+    T.uconstDef T.mkRoot (+*&=&=*&=$*==)+      (\ p -> gprimHandlePosnEq T.mkNoSrcPos p)+  ++gstdin :: T.RefSrcPos -> T.RefExp -> T.R Handle++gstdin pstdin p = T.uconstUse pstdin p sstdin++sstdin = T.uconstDef T.mkRoot astdin (\ p -> fromHandle p IO.stdin)++gstdout :: T.RefSrcPos -> T.RefExp -> T.R Handle++gstdout pstdout p = T.uconstUse pstdout p sstdout++sstdout = T.uconstDef T.mkRoot astdout (\ p -> fromHandle p IO.stdout)++gstderr :: T.RefSrcPos -> T.RefExp -> T.R Handle++gstderr pstderr p = T.uconstUse pstderr p sstderr++sstderr = T.uconstDef T.mkRoot astderr (\ p -> fromHandle p IO.stderr)++gopenFile ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun String (T.Fun IOMode (IO Handle)))++gopenFile popenFile p = T.ufun2 aopenFile popenFile p hopenFile++hopenFile z1openFile z2openFile kopenFile =+  (T.fromIO fromHandle) kopenFile+    (IO.openFile (toString kopenFile z1openFile)+      (toIOMode kopenFile z2openFile))++ghClose :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Handle (IO T.Tuple0))++ghClose phClose p = T.ufun1 ahClose phClose p hhClose++hhClose z1hClose khClose =+  (T.fromIO T.fromTuple0) khClose (IO.hClose (toHandle khClose z1hClose))++ghFileSize :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Handle (IO Integer))++ghFileSize phFileSize p = T.ufun1 ahFileSize phFileSize p hhFileSize++hhFileSize z1hFileSize khFileSize =+  (T.fromIO T.fromInteger) khFileSize+    (IO.hFileSize (toHandle khFileSize z1hFileSize))++ghIsEOF :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Handle (IO Bool))++ghIsEOF phIsEOF p = T.ufun1 ahIsEOF phIsEOF p hhIsEOF++hhIsEOF z1hIsEOF khIsEOF =+  (T.fromIO fromBool) khIsEOF (IO.hIsEOF (toHandle khIsEOF z1hIsEOF))++gisEOF :: T.RefSrcPos -> T.RefExp -> T.R (IO Bool)++sisEOF :: T.R (IO Bool)++gisEOF pisEOF p = T.uconstUse pisEOF p sisEOF++sisEOF =+  T.uconstDef T.mkRoot aisEOF+    (\ p -> T.uwrapForward p (hhIsEOF (gstdin T.mkNoSrcPos p) p))++ghSetBuffering ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Handle (T.Fun BufferMode (IO T.Tuple0)))++ghSetBuffering phSetBuffering p =+  T.ufun2 ahSetBuffering phSetBuffering p hhSetBuffering++hhSetBuffering z1hSetBuffering z2hSetBuffering khSetBuffering =+  (T.fromIO T.fromTuple0) khSetBuffering+    (IO.hSetBuffering (toHandle khSetBuffering z1hSetBuffering)+      (toBufferMode khSetBuffering z2hSetBuffering))++ghGetBuffering :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Handle (IO BufferMode))++ghGetBuffering phGetBuffering p =+  T.ufun1 ahGetBuffering phGetBuffering p hhGetBuffering++hhGetBuffering z1hGetBuffering khGetBuffering =+  (T.fromIO fromBufferMode) khGetBuffering+    (IO.hGetBuffering (toHandle khGetBuffering z1hGetBuffering))++ghFlush :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Handle (IO T.Tuple0))++ghFlush phFlush p = T.ufun1 ahFlush phFlush p hhFlush++hhFlush z1hFlush khFlush =+  (T.fromIO T.fromTuple0) khFlush (IO.hFlush (toHandle khFlush z1hFlush))++ghGetPosn :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Handle (IO HandlePosn))++ghGetPosn phGetPosn p = T.ufun1 ahGetPosn phGetPosn p hhGetPosn++hhGetPosn z1hGetPosn khGetPosn =+  (T.fromIO fromHandlePosn) khGetPosn+    (IO.hGetPosn (toHandle khGetPosn z1hGetPosn))++ghSetPosn :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun HandlePosn (IO T.Tuple0))++ghSetPosn phSetPosn p = T.ufun1 ahSetPosn phSetPosn p hhSetPosn++hhSetPosn z1hSetPosn khSetPosn =+  (T.fromIO T.fromTuple0) khSetPosn+    (IO.hSetPosn (toHandlePosn khSetPosn z1hSetPosn))++ghSeek ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R (T.Fun Handle (T.Fun SeekMode (T.Fun Integer (IO T.Tuple0))))++ghSeek phSeek p = T.ufun3 ahSeek phSeek p hhSeek++hhSeek z1hSeek z2hSeek z3hSeek khSeek =+  (T.fromIO T.fromTuple0) khSeek+    (IO.hSeek (toHandle khSeek z1hSeek) (toSeekMode khSeek z2hSeek)+      (T.toInteger khSeek z3hSeek))++ghWaitForInput ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Handle (T.Fun Int (IO Bool)))++ghWaitForInput phWaitForInput p =+  T.ufun2 ahWaitForInput phWaitForInput p hhWaitForInput++hhWaitForInput z1hWaitForInput z2hWaitForInput khWaitForInput =+  (T.fromIO fromBool) khWaitForInput+    (IO.hWaitForInput (toHandle khWaitForInput z1hWaitForInput)+      (T.toInt khWaitForInput z2hWaitForInput))++ghReady :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Handle (IO Bool))++hhReady :: (T.R Handle) -> T.RefExp -> T.R (IO Bool)++ghReady phReady p = T.ufun1 ahReady phReady p hhReady++hhReady fh p =+  T.uwrapForward p+    (hhWaitForInput fh+      (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 0)) p)++ghGetChar :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Handle (IO Char))++ghGetChar phGetChar p = T.ufun1 ahGetChar phGetChar p hhGetChar++hhGetChar z1hGetChar khGetChar =+  (T.fromIO T.fromChar) khGetChar (IO.hGetChar (toHandle khGetChar z1hGetChar))++ghGetLine :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Handle (IO String))++ghGetLine phGetLine p = T.ufun1 ahGetLine phGetLine p hhGetLine++hhGetLine z1hGetLine khGetLine =+  (T.fromIO fromString) khGetLine (IO.hGetLine (toHandle khGetLine z1hGetLine))++ghLookAhead :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Handle (IO Char))++ghLookAhead phLookAhead p = T.ufun1 ahLookAhead phLookAhead p hhLookAhead++hhLookAhead z1hLookAhead khLookAhead =+  (T.fromIO T.fromChar) khLookAhead+    (IO.hLookAhead (toHandle khLookAhead z1hLookAhead))++ghGetContents :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Handle (IO String))++ghGetContents phGetContents p =+  T.ufun1 ahGetContents phGetContents p hhGetContents++hhGetContents z1hGetContents khGetContents =+  (T.fromIO fromString) khGetContents+    (IO.hGetContents (toHandle khGetContents z1hGetContents))++ghPutChar ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Handle (T.Fun Char (IO T.Tuple0)))++ghPutChar phPutChar p = T.ufun2 ahPutChar phPutChar p hhPutChar++hhPutChar z1hPutChar z2hPutChar khPutChar =+  (T.fromIO T.fromTuple0) khPutChar+    ((\_ h c -> T.outputTrace khPutChar [c] Prelude.>> IO.hPutChar h c) Prelude.True+      (toHandle khPutChar z1hPutChar) (T.toChar khPutChar z2hPutChar))++ghPutStr ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Handle (T.Fun String (IO T.Tuple0)))++ghPutStr phPutStr p = T.ufun2 ahPutStr phPutStr p hhPutStr++hhPutStr z1hPutStr z2hPutStr khPutStr =+  (T.fromIO T.fromTuple0) khPutStr+    ((\_ h s -> T.outputTrace khPutStr s Prelude.>> IO.hPutStr h s) Prelude.True+      (toHandle khPutStr z1hPutStr) (toString khPutStr z2hPutStr))++ghPutStrLn ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Handle (T.Fun String (IO T.Tuple0)))++hhPutStrLn :: (T.R Handle) -> (T.R String) -> T.RefExp -> T.R (IO T.Tuple0)++ghPutStrLn phPutStrLn p = T.ufun2 ahPutStrLn phPutStrLn p hhPutStrLn++hhPutStrLn fh fs p =+  T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>> p)+    (T.uwrapForward p (hhPutStr fh fs p))+    (T.uwrapForward p (hhPutStr fh (T.fromLitString T.mkNoSrcPos p "\n") p))++ghPrint ::+  Show a =>+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Handle (T.Fun a (IO T.Tuple0)))++hhPrint :: Show a => (T.R Handle) -> (T.R a) -> T.RefExp -> T.R (IO T.Tuple0)++ghPrint phPrint p = T.ufun2 ahPrint phPrint p hhPrint++hhPrint fh fx p =+  T.uwrapForward p+    (hhPutStrLn fh (T.uap1 T.mkNoSrcPos p (gshow T.mkNoSrcPos p) fx) p)++ghIsOpen :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Handle (IO Bool))++ghIsOpen phIsOpen p = T.ufun1 ahIsOpen phIsOpen p hhIsOpen++hhIsOpen z1hIsOpen khIsOpen =+  (T.fromIO fromBool) khIsOpen (IO.hIsOpen (toHandle khIsOpen z1hIsOpen))++ghIsClosed :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Handle (IO Bool))++ghIsClosed phIsClosed p = T.ufun1 ahIsClosed phIsClosed p hhIsClosed++hhIsClosed z1hIsClosed khIsClosed =+  (T.fromIO fromBool) khIsClosed+    (IO.hIsClosed (toHandle khIsClosed z1hIsClosed))++ghIsReadable :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Handle (IO Bool))++ghIsReadable phIsReadable p = T.ufun1 ahIsReadable phIsReadable p hhIsReadable++hhIsReadable z1hIsReadable khIsReadable =+  (T.fromIO fromBool) khIsReadable+    (IO.hIsReadable (toHandle khIsReadable z1hIsReadable))++ghIsWritable :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Handle (IO Bool))++ghIsWritable phIsWritable p = T.ufun1 ahIsWritable phIsWritable p hhIsWritable++hhIsWritable z1hIsWritable khIsWritable =+  (T.fromIO fromBool) khIsWritable+    (IO.hIsWritable (toHandle khIsWritable z1hIsWritable))++ghIsSeekable :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Handle (IO Bool))++ghIsSeekable phIsSeekable p = T.ufun1 ahIsSeekable phIsSeekable p hhIsSeekable++hhIsSeekable z1hIsSeekable khIsSeekable =+  (T.fromIO fromBool) khIsSeekable+    (IO.hIsSeekable (toHandle khIsSeekable z1hIsSeekable))++gisAlreadyExistsError :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun IOError Bool)++gisAlreadyExistsError pisAlreadyExistsError p =+  T.ufun1 aisAlreadyExistsError pisAlreadyExistsError p hisAlreadyExistsError++hisAlreadyExistsError z1isAlreadyExistsError kisAlreadyExistsError =+  fromBool kisAlreadyExistsError+    (Error.isAlreadyExistsError+      (toIOError kisAlreadyExistsError z1isAlreadyExistsError))++gisDoesNotExistError :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun IOError Bool)++gisDoesNotExistError pisDoesNotExistError p =+  T.ufun1 aisDoesNotExistError pisDoesNotExistError p hisDoesNotExistError++hisDoesNotExistError z1isDoesNotExistError kisDoesNotExistError =+  fromBool kisDoesNotExistError+    (Error.isDoesNotExistError+      (toIOError kisDoesNotExistError z1isDoesNotExistError))++gisAlreadyInUseError :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun IOError Bool)++gisAlreadyInUseError pisAlreadyInUseError p =+  T.ufun1 aisAlreadyInUseError pisAlreadyInUseError p hisAlreadyInUseError++hisAlreadyInUseError z1isAlreadyInUseError kisAlreadyInUseError =+  fromBool kisAlreadyInUseError+    (Error.isAlreadyInUseError+      (toIOError kisAlreadyInUseError z1isAlreadyInUseError))++gisFullError :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun IOError Bool)++gisFullError pisFullError p = T.ufun1 aisFullError pisFullError p hisFullError++hisFullError z1isFullError kisFullError =+  fromBool kisFullError+    (Error.isFullError (toIOError kisFullError z1isFullError))++gisEOFError :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun IOError Bool)++gisEOFError pisEOFError p = T.ufun1 aisEOFError pisEOFError p hisEOFError++hisEOFError z1isEOFError kisEOFError =+  fromBool kisEOFError (Error.isEOFError (toIOError kisEOFError z1isEOFError))++gisIllegalOperation :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun IOError Bool)++gisIllegalOperation pisIllegalOperation p =+  T.ufun1 aisIllegalOperation pisIllegalOperation p hisIllegalOperation++hisIllegalOperation z1isIllegalOperation kisIllegalOperation =+  fromBool kisIllegalOperation+    (Error.isIllegalOperation+      (toIOError kisIllegalOperation z1isIllegalOperation))++gisPermissionError :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun IOError Bool)++gisPermissionError pisPermissionError p =+  T.ufun1 aisPermissionError pisPermissionError p hisPermissionError++hisPermissionError z1isPermissionError kisPermissionError =+  fromBool kisPermissionError+    (Error.isPermissionError (toIOError kisPermissionError z1isPermissionError))++gisUserError :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun IOError Bool)++gisUserError pisUserError p = T.ufun1 aisUserError pisUserError p hisUserError++hisUserError z1isUserError kisUserError =+  fromBool kisUserError+    (Error.isUserError (toIOError kisUserError z1isUserError))++gioeGetErrorString :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun IOError String)++gioeGetErrorString pioeGetErrorString p =+  T.ufun1 aioeGetErrorString pioeGetErrorString p hioeGetErrorString++hioeGetErrorString z1ioeGetErrorString kioeGetErrorString =+  fromString kioeGetErrorString+    (Error.ioeGetErrorString (toIOError kioeGetErrorString z1ioeGetErrorString))++gioeGetHandle :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun IOError (Maybe Handle))++gioeGetHandle pioeGetHandle p =+  T.ufun1 aioeGetHandle pioeGetHandle p hioeGetHandle++hioeGetHandle z1ioeGetHandle kioeGetHandle =+  (fromMaybe fromHandle) kioeGetHandle+    (Error.ioeGetHandle (toIOError kioeGetHandle z1ioeGetHandle))++gioeGetFileName :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun IOError (Maybe String))++gioeGetFileName pioeGetFileName p =+  T.ufun1 aioeGetFileName pioeGetFileName p hioeGetFileName++hioeGetFileName z1ioeGetFileName kioeGetFileName =+  (fromMaybe fromString) kioeGetFileName+    (Error.ioeGetFileName (toIOError kioeGetFileName z1ioeGetFileName))++gtry :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun (IO a) (IO (Either IOError a)))++htry :: (T.R (IO a)) -> T.RefExp -> T.R (IO (Either IOError a))++gtry ptry p = T.ufun1 atry ptry p htry++htry ff p =+  T.uwrapForward p+    (hcatch+      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>>= p) ff+        (T.ufun1 T.mkDoLambda T.mkNoSrcPos p+          (\ fr p ->+            T.uap1 T.mkNoSrcPos p (greturn T.mkNoSrcPos p)+              (T.con1 T.mkNoSrcPos p Right aRight fr))))+      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !. p) (greturn T.mkNoSrcPos p)+        (T.pa0 Left T.cn1 T.mkNoSrcPos p aLeft)) p)++gbracket ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (IO a) (T.Fun (T.Fun a (IO b)) (T.Fun (T.Fun a (IO c)) (IO c))))++hbracket ::+  (T.R (IO a)) ->+    (T.R (T.Fun a (IO b))) -> (T.R (T.Fun a (IO c))) -> T.RefExp -> T.R (IO c)++gbracket pbracket p = T.ufun3 abracket pbracket p hbracket++hbracket fbefore fafter fm p =+  T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>>= p) fbefore+    (T.ufun1 T.mkDoLambda T.mkNoSrcPos p+      (\ fx p ->+        T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>>= p)+          (T.uwrapForward p (htry (T.uap1 T.mkNoSrcPos p fm fx) p))+          (T.ufun1 T.mkDoLambda T.mkNoSrcPos p+            (\ frs p ->+              T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>> p)+                (T.uap1 T.mkNoSrcPos p fafter fx)+                (T.uccase T.mkNoSrcPos p+                  (let+                    v173v9v175v31v1 (T.R (Right fr) _) p =+                      T.uap1 T.mkNoSrcPos p (greturn T.mkNoSrcPos p) fr+                    v173v9v175v31v1 (T.R (Left fe) _) p =+                      T.uwrapForward p (hioError fe p)+                    v173v9v175v31v1 _ p = T.fatal p in (v173v9v175v31v1))+                  frs)))))++gbracket_ ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R (T.Fun (IO a) (T.Fun (T.Fun a (IO b)) (T.Fun (IO c) (IO c))))++hbracket_ ::+  (T.R (IO a)) ->+    (T.R (T.Fun a (IO b))) -> (T.R (IO c)) -> T.RefExp -> T.R (IO c)++gbracket_ pbracket_ p = T.ufun3 abracket_ pbracket_ p hbracket_++hbracket_ fbefore fafter fm p =+  T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>>= p) fbefore+    (T.ufun1 T.mkDoLambda T.mkNoSrcPos p+      (\ fx p ->+        T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>>= p)+          (T.uwrapForward p (htry fm p))+          (T.ufun1 T.mkDoLambda T.mkNoSrcPos p+            (\ frs p ->+              T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>> p)+                (T.uap1 T.mkNoSrcPos p fafter fx)+                (T.uccase T.mkNoSrcPos p+                  (let+                    v183v10v185v32v1 (T.R (Right fr) _) p =+                      T.uap1 T.mkNoSrcPos p (greturn T.mkNoSrcPos p) fr+                    v183v10v185v32v1 (T.R (Left fe) _) p =+                      T.uwrapForward p (hioError fe p)+                    v183v10v185v32v1 _ p = T.fatal p in (v183v10v185v32v1))+                  frs)))))++tIO = T.mkModule "IO" "IO.hs" Prelude.False++aprimHandleEq = T.mkVariable tIO 360001 370041 3 2 "primHandleEq" Prelude.False++aprimHandleShowsPrec =+  T.mkVariable tIO 390001 400057 3 3 "primHandleShowsPrec" Prelude.False++aprimHandlePosnEq =+  T.mkVariable tIO 500001 510053 3 2 "primHandlePosnEq" Prelude.False++astdin = T.mkVariable tIO 650001 660016 3 0 "stdin" Prelude.False++astdout = T.mkVariable tIO 670001 680017 3 0 "stdout" Prelude.False++astderr = T.mkVariable tIO 690001 700017 3 0 "stderr" Prelude.False++aopenFile = T.mkVariable tIO 720001 730048 3 2 "openFile" Prelude.False++ahClose = T.mkVariable tIO 740001 750038 3 1 "hClose" Prelude.False++ahFileSize = T.mkVariable tIO 770001 780038 3 1 "hFileSize" Prelude.False++ahIsEOF = T.mkVariable tIO 790001 800038 3 1 "hIsEOF" Prelude.False++aisEOF = T.mkVariable tIO 830001 830037 3 0 "isEOF" Prelude.False++ahSetBuffering =+  T.mkVariable tIO 850001 860053 3 2 "hSetBuffering" Prelude.False++ahGetBuffering =+  T.mkVariable tIO 870001 880039 3 1 "hGetBuffering" Prelude.False++ahFlush = T.mkVariable tIO 890001 900038 3 1 "hFlush" Prelude.False++ahGetPosn = T.mkVariable tIO 910001 920038 3 1 "hGetPosn" Prelude.False++ahSetPosn = T.mkVariable tIO 930001 940042 3 1 "hSetPosn" Prelude.False++ahSeek = T.mkVariable tIO 950001 960061 3 3 "hSeek" Prelude.False++ahWaitForInput =+  T.mkVariable tIO 980001 990043 3 2 "hWaitForInput" Prelude.False++ahReady = T.mkVariable tIO 1020001 1020028 3 1 "hReady" Prelude.False++ahGetChar = T.mkVariable tIO 1040001 1050038 3 1 "hGetChar" Prelude.False++ahGetLine = T.mkVariable tIO 1060001 1070038 3 1 "hGetLine" Prelude.False++ahLookAhead = T.mkVariable tIO 1080001 1090038 3 1 "hLookAhead" Prelude.False++ahGetContents =+  T.mkVariable tIO 1100001 1110038 3 1 "hGetContents" Prelude.False++ahPutChar = T.mkVariable tIO 1120001 1130046 3 2 "hPutChar" Prelude.False++ahPutStr = T.mkVariable tIO 1140001 1150048 3 2 "hPutStr" Prelude.False++ahPutStrLn = T.mkVariable tIO 1180001 1190038 3 2 "hPutStrLn" Prelude.False++ahPrint = T.mkVariable tIO 1220001 1220032 3 2 "hPrint" Prelude.False++ahIsOpen = T.mkVariable tIO 1240001 1250038 3 1 "hIsOpen" Prelude.False++ahIsClosed = T.mkVariable tIO 1260001 1270038 3 1 "hIsClosed" Prelude.False++ahIsReadable = T.mkVariable tIO 1280001 1290038 3 1 "hIsReadable" Prelude.False++ahIsWritable = T.mkVariable tIO 1300001 1310038 3 1 "hIsWritable" Prelude.False++ahIsSeekable = T.mkVariable tIO 1320001 1330038 3 1 "hIsSeekable" Prelude.False++aisAlreadyExistsError =+  T.mkVariable tIO 1350001 1360041 3 1 "isAlreadyExistsError" Prelude.False++aisDoesNotExistError =+  T.mkVariable tIO 1370001 1380041 3 1 "isDoesNotExistError" Prelude.False++aisAlreadyInUseError =+  T.mkVariable tIO 1390001 1400041 3 1 "isAlreadyInUseError" Prelude.False++aisFullError = T.mkVariable tIO 1410001 1420041 3 1 "isFullError" Prelude.False++aisEOFError = T.mkVariable tIO 1430001 1440041 3 1 "isEOFError" Prelude.False++aisIllegalOperation =+  T.mkVariable tIO 1450001 1460041 3 1 "isIllegalOperation" Prelude.False++aisPermissionError =+  T.mkVariable tIO 1470001 1480041 3 1 "isPermissionError" Prelude.False++aisUserError = T.mkVariable tIO 1490001 1500041 3 1 "isUserError" Prelude.False++aioeGetErrorString =+  T.mkVariable tIO 1520001 1530043 3 1 "ioeGetErrorString" Prelude.False++aioeGetHandle =+  T.mkVariable tIO 1540001 1550042 3 1 "ioeGetHandle" Prelude.False++aioeGetFileName =+  T.mkVariable tIO 1570001 1580042 3 1 "ioeGetFileName" Prelude.False++atry = T.mkVariable tIO 1640001 1660038 3 1 "try" Prelude.False++abracket = T.mkVariable tIO 1690001 1750031 3 3 "bracket" Prelude.False++abracket_ = T.mkVariable tIO 1790001 1850032 3 3 "bracket_" Prelude.False++(+&%=&=&%=$#==) = T.mkVariable tIO 430004 430021 16 0 "==" Prelude.False++a46v3v46v33showsPrec =+  T.mkVariable tIO 460003 460033 3 0 "showsPrec" Prelude.False++(+*&=&=*&=$*==) = T.mkVariable tIO 540004 540025 16 0 "==" Prelude.False
+ Hat/IOBuiltin.hs view
@@ -0,0 +1,63 @@+module Hat.IOBuiltin where++import qualified System.IO as IO+import System.IO(Handle,HandlePosn)+import qualified Prelude+import Hat.Hat as T +import Hat.PreludeBuiltinTypes+import Hat.Prelude+import Hat.IOBuiltinTypes++toHandle :: RefExp -> R Handle -> IO.Handle+toHandle h (R e _) = e++fromHandle :: RefExp -> IO.Handle -> R Handle+fromHandle h e = R e (T.mkValueUse h mkNoSrcPos aHandle)++aHandle :: RefAtom+aHandle = mkAbstract "Handle"++toHandlePosn :: RefExp -> R HandlePosn -> IO.HandlePosn+toHandlePosn h (R e _) = e++fromHandlePosn :: RefExp -> IO.HandlePosn -> R HandlePosn+fromHandlePosn h p = R p (T.mkValueUse h mkNoSrcPos aHandlePosn)++aHandlePosn :: RefAtom+aHandlePosn = mkAbstract "HandlePosn"++fromMaybe :: (RefExp -> a -> R b) -> RefExp -> Prelude.Maybe a -> R (Maybe b)+fromMaybe f h Prelude.Nothing = T.con0 mkNoSrcPos h Nothing aNothing+fromMaybe f h (Prelude.Just arg) = +  T.con1 mkNoSrcPos h Just aJust (T.wrapForward h (f h arg))++toMaybe :: (RefExp -> R a -> b) -> RefExp -> R (Maybe a) -> Prelude.Maybe b+toMaybe f h (R Nothing _) = Prelude.Nothing+toMaybe f h (R (Just x) _) = Prelude.Just (f h x)++toIOMode :: RefExp -> R IOMode -> IO.IOMode+toIOMode h (R ReadMode _) = IO.ReadMode+toIOMode h (R WriteMode _) = IO.WriteMode+toIOMode h (R AppendMode _) = IO.AppendMode+toIOMode h (R ReadWriteMode _) = IO.ReadWriteMode++toBufferMode :: RefExp -> R BufferMode -> IO.BufferMode+toBufferMode h (R (BlockBuffering maybeInt) _) = +  IO.BlockBuffering (toMaybe toInt h maybeInt)+toBufferMode h (R NoBuffering _) = IO.NoBuffering+toBufferMode h (R LineBuffering _) = IO.LineBuffering++fromBufferMode :: RefExp -> IO.BufferMode -> R BufferMode+fromBufferMode h (IO.BlockBuffering maybeInt) = +  T.con1 mkNoSrcPos h BlockBuffering aBlockBuffering +    (T.wrapForward h (fromMaybe fromInt h maybeInt))+fromBufferMode h IO.NoBuffering = +  T.con0 mkNoSrcPos h NoBuffering aNoBuffering+fromBufferMode h IO.LineBuffering = +  T.con0 mkNoSrcPos h LineBuffering aLineBuffering++toSeekMode :: RefExp -> R SeekMode -> IO.SeekMode+toSeekMode h (R AbsoluteSeek _) = IO.AbsoluteSeek+toSeekMode h (R RelativeSeek _) = IO.RelativeSeek+toSeekMode h (R SeekFromEnd _) = IO.SeekFromEnd+
+ Hat/IOBuiltinTypes.hs view
@@ -0,0 +1,1120 @@+module Hat.IOBuiltinTypes+  (IOMode(..),BufferMode(..),SeekMode(..),aReadMode,aWriteMode,aAppendMode+    ,aReadWriteMode,aNoBuffering,aLineBuffering,aBlockBuffering,aAbsoluteSeek+    ,aRelativeSeek,aSeekFromEnd) where++import qualified Hat.PreludeBasic +import qualified Prelude +import Hat.Hack +import qualified Hat.Hat as T +import Hat.Hat  (WrapVal(wrapVal))+import Hat.Prelude +import Hat.Ix  (Ix(..))++data IOMode = ReadMode  | WriteMode  | AppendMode  | ReadWriteMode ++instance T.WrapVal (IOMode)+  where+  +  wrapVal pwrapVal (kwrapVal@ReadMode) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aReadMode)+  wrapVal pwrapVal (kwrapVal@WriteMode) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aWriteMode)+  wrapVal pwrapVal (kwrapVal@AppendMode) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aAppendMode)+  wrapVal pwrapVal (kwrapVal@ReadWriteMode) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aReadWriteMode)+  ++instance Eq (IOMode)+  where+  +  (!==) (%==) p =+    T.ufun2 (++=%$=+=%%==) (%==) p (*==)+    where+    +    (*==) (T.R ReadMode _) (T.R ReadMode _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R WriteMode _) (T.R WriteMode _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R AppendMode _) (T.R AppendMode _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R ReadWriteMode _) (T.R ReadWriteMode _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) _ _ p = T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse+    +  ++instance Ord (IOMode)+  where+  +  gcompare pcompare p =+    T.ufun2 a6v36v6v38compare pcompare p hcompare+    where+    +    hcompare fy1 fy2 p =+      T.uap2 T.mkNoSrcPos p (Hat.Prelude.gcompare T.mkNoSrcPos p)+        (T.uwrapForward p (hlocalFromEnum fy1 p) :: T.R Hat.Prelude.Int)+        (T.uwrapForward p (hlocalFromEnum fy2 p))+      where+      +      glocalFromEnum plocalFromEnum p =+        T.ufun1 a6v36v6v38localFromEnum plocalFromEnum p hlocalFromEnum+      +      alocalFromEnum = a6v36v6v38localFromEnum+      +      hlocalFromEnum (T.R (ReadMode) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0)+      hlocalFromEnum (T.R (WriteMode) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 1)+      hlocalFromEnum (T.R (AppendMode) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 2)+      hlocalFromEnum (T.R (ReadWriteMode) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 3)+      hlocalFromEnum _ p = T.fatal p+      +    +  ++instance Ix (IOMode)+  where+  +  grange prange p =+    T.ufun1 a6v41v6v42range prange p hrange+    where+    +    hrange (T.R (T.Tuple2 fy1 fy2) _) p =+      T.uwrapForward p+        (Hat.PreludeBasic.hmap (glocalToEnum T.mkNoSrcPos p)+          (T.uap2 T.mkNoSrcPos p (Hat.Prelude.genumFromTo T.mkNoSrcPos p)+            (T.uwrapForward p (hlocalFromEnum fy1 p))+            (T.uwrapForward p (hlocalFromEnum fy2 p))) p)+      where+      +      glocalToEnum ::+        T.RefSrcPos -> T.RefExp -> T.R (T.Fun Hat.Prelude.Int IOMode)+      +      hlocalToEnum :: (T.R Hat.Prelude.Int) -> T.RefExp -> T.R IOMode+      +      glocalToEnum plocalToEnum p =+        T.ufun1 a6v41v6v42localToEnum plocalToEnum p hlocalToEnum+      +      alocalToEnum = a6v41v6v42localToEnum+      +      hlocalToEnum fv6v41v6v42n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv6v41v6v42n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 0))) (h p)+          (y1localToEnum fv6v41v6v42n p)+        where+        +        h p = T.con0 T.mkNoSrcPos p ReadMode aReadMode+        h p = y1localToEnum fv6v41v6v42n p+        +      hlocalToEnum fv6v41v6v42n p = y1localToEnum fv6v41v6v42n p+      +      y1localToEnum fv6v41v6v42n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv6v41v6v42n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 1))) (h p)+          (y2localToEnum fv6v41v6v42n p)+        where+        +        h p = T.con0 T.mkNoSrcPos p WriteMode aWriteMode+        h p = y2localToEnum fv6v41v6v42n p+        +      y1localToEnum fv6v41v6v42n p = y2localToEnum fv6v41v6v42n p+      +      y2localToEnum fv6v41v6v42n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv6v41v6v42n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 2))) (h p)+          (y3localToEnum fv6v41v6v42n p)+        where+        +        h p = T.con0 T.mkNoSrcPos p AppendMode aAppendMode+        h p = y3localToEnum fv6v41v6v42n p+        +      y2localToEnum fv6v41v6v42n p = y3localToEnum fv6v41v6v42n p+      +      y3localToEnum fv6v41v6v42n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv6v41v6v42n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 3))) (h p) (T.fatal p)+        where+        +        h p = T.con0 T.mkNoSrcPos p ReadWriteMode aReadWriteMode+        h p = T.fatal p+        +      y3localToEnum _ p = T.fatal p+      +      glocalFromEnum ::+        T.RefSrcPos -> T.RefExp -> T.R (T.Fun IOMode Hat.Prelude.Int)+      +      hlocalFromEnum :: (T.R IOMode) -> T.RefExp -> T.R Hat.Prelude.Int+      +      glocalFromEnum plocalFromEnum p =+        T.ufun1 a6v41v6v42localFromEnum plocalFromEnum p hlocalFromEnum+      +      alocalFromEnum = a6v41v6v42localFromEnum+      +      hlocalFromEnum (T.R ReadMode _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0)+      hlocalFromEnum (T.R WriteMode _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 1)+      hlocalFromEnum (T.R AppendMode _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 2)+      hlocalFromEnum (T.R ReadWriteMode _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 3)+      hlocalFromEnum _ p = T.fatal p+      +    hrange _ p = T.fatal p+    +  +  gindex pindex p =+    T.ufun2 a6v41v6v42index pindex p hindex+    where+    +    hindex (T.R (T.Tuple2 fy1 fy2) _) fy3 p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!- p)+        (T.uwrapForward p (hlocalFromEnum fy3 p))+        (T.uwrapForward p (hlocalFromEnum fy1 p))+      where+      +      glocalFromEnum ::+        T.RefSrcPos -> T.RefExp -> T.R (T.Fun IOMode Hat.Prelude.Int)+      +      hlocalFromEnum :: (T.R IOMode) -> T.RefExp -> T.R Hat.Prelude.Int+      +      glocalFromEnum plocalFromEnum p =+        T.ufun1 a6v41v6v42localFromEnum plocalFromEnum p hlocalFromEnum+      +      alocalFromEnum = a6v41v6v42localFromEnum+      +      hlocalFromEnum (T.R ReadMode _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0)+      hlocalFromEnum (T.R WriteMode _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 1)+      hlocalFromEnum (T.R AppendMode _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 2)+      hlocalFromEnum (T.R ReadWriteMode _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 3)+      hlocalFromEnum _ p = T.fatal p+      +    hindex _ _ p = T.fatal p+    +  +  ginRange pinRange p =+    T.ufun2 a6v41v6v42inRange pinRange p hinRange+    where+    +    hinRange (T.R (T.Tuple2 fy1 fy2) _) fy3 p =+      T.uap2 T.mkNoSrcPos p (Hat.Ix.ginRange T.mkNoSrcPos p)+        (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+          (T.uwrapForward p (hlocalFromEnum fy1 p))+          (T.uwrapForward p (hlocalFromEnum fy2 p)))+        (T.uwrapForward p (hlocalFromEnum fy3 p))+      where+      +      glocalFromEnum ::+        T.RefSrcPos -> T.RefExp -> T.R (T.Fun IOMode Hat.Prelude.Int)+      +      hlocalFromEnum :: (T.R IOMode) -> T.RefExp -> T.R Hat.Prelude.Int+      +      glocalFromEnum plocalFromEnum p =+        T.ufun1 a6v41v6v42localFromEnum plocalFromEnum p hlocalFromEnum+      +      alocalFromEnum = a6v41v6v42localFromEnum+      +      hlocalFromEnum (T.R ReadMode _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0)+      hlocalFromEnum (T.R WriteMode _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 1)+      hlocalFromEnum (T.R AppendMode _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 2)+      hlocalFromEnum (T.R ReadWriteMode _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 3)+      hlocalFromEnum _ p = T.fatal p+      +    hinRange _ _ p = T.fatal p+    +  ++instance Bounded (IOMode)+  where+  +  gminBound pminBound p = T.uconstUse pminBound p sminBound+  +  sminBound =+    T.uconstDef T.mkRoot a6v45v6v51minBound+      (\ p -> T.con0 T.mkNoSrcPos p ReadMode aReadMode)+  +  gmaxBound pmaxBound p = T.uconstUse pmaxBound p smaxBound+  +  smaxBound =+    T.uconstDef T.mkRoot a6v45v6v51maxBound+      (\ p -> T.con0 T.mkNoSrcPos p ReadWriteMode aReadWriteMode)+  ++instance Enum (IOMode)+  where+  +  gfromEnum pfromEnum p =+    T.ufun1 a6v54v6v57fromEnum pfromEnum p hfromEnum+    where+    +    hfromEnum (T.R ReadMode _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 0)+    hfromEnum (T.R WriteMode _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 1)+    hfromEnum (T.R AppendMode _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 2)+    hfromEnum (T.R ReadWriteMode _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 3)+    hfromEnum _ p = T.fatal p+    +  +  gtoEnum ptoEnum p =+    T.ufun1 a6v54v6v57toEnum ptoEnum p htoEnum+    where+    +    htoEnum fv6v54v6v57n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv6v54v6v57n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 0))) (h p) (y1toEnum fv6v54v6v57n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p ReadMode aReadMode+      h p = y1toEnum fv6v54v6v57n p+      +    htoEnum fv6v54v6v57n p = y1toEnum fv6v54v6v57n p+    +    y1toEnum fv6v54v6v57n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv6v54v6v57n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 1))) (h p) (y2toEnum fv6v54v6v57n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p WriteMode aWriteMode+      h p = y2toEnum fv6v54v6v57n p+      +    y1toEnum fv6v54v6v57n p = y2toEnum fv6v54v6v57n p+    +    y2toEnum fv6v54v6v57n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv6v54v6v57n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 2))) (h p) (y3toEnum fv6v54v6v57n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p AppendMode aAppendMode+      h p = y3toEnum fv6v54v6v57n p+      +    y2toEnum fv6v54v6v57n p = y3toEnum fv6v54v6v57n p+    +    y3toEnum fv6v54v6v57n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv6v54v6v57n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 3))) (h p) (y4toEnum fv6v54v6v57n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p ReadWriteMode aReadWriteMode+      h p = y4toEnum fv6v54v6v57n p+      +    y3toEnum fv6v54v6v57n p = y4toEnum fv6v54v6v57n p+    +    y4toEnum _ p =+      T.uwrapForward p+        (Hat.Prelude.herror+          (T.fromLitString T.mkNoSrcPos p "toEnum: argument out of bounds") p)+    +  +  genumFrom penumFrom p =+    T.ufun1 a6v54v6v57enumFrom penumFrom p henumFrom+    where+    +    henumFrom fy1 p =+      T.uap2 T.mkNoSrcPos p (Hat.Prelude.genumFromTo T.mkNoSrcPos p) fy1+        (T.con0 T.mkNoSrcPos p ReadWriteMode aReadWriteMode)+    +  +  genumFromThen penumFromThen p =+    T.ufun2 a6v54v6v57enumFromThen penumFromThen p henumFromThen+    where+    +    henumFromThen fy1 fy2 p =+      T.uap3 T.mkNoSrcPos p (Hat.Prelude.genumFromThenTo T.mkNoSrcPos p) fy1 fy2+        (T.ucif p+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>= p)+            (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gfromEnum T.mkNoSrcPos p) fy1)+            (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gfromEnum T.mkNoSrcPos p) fy2))+          (T.con0 T.mkNoSrcPos p ReadWriteMode aReadWriteMode)+          (T.con0 T.mkNoSrcPos p ReadMode aReadMode))+    +  ++instance Read (IOMode)+  where+  +  greadsPrec preadsPrec p =+    T.ufun1 a6v60v6v63readsPrec preadsPrec p hreadsPrec+    where+    +    hreadsPrec fy1 p =+      T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.galt T.mkNoSrcPos p)+        (T.uwrapForward p+          (Hat.Prelude.hreadParen+            (T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse)+            (T.uwrapForward p+              (Hat.PreludeBasic.hthenLex+                (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                  (T.con0 T.mkNoSrcPos p ReadMode aReadMode))+                (T.fromLitString T.mkNoSrcPos p "ReadMode") p)) p))+        (T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.galt T.mkNoSrcPos p)+          (T.uwrapForward p+            (Hat.Prelude.hreadParen+              (T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse)+              (T.uwrapForward p+                (Hat.PreludeBasic.hthenLex+                  (T.uap1 T.mkNoSrcPos p+                    (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                    (T.con0 T.mkNoSrcPos p WriteMode aWriteMode))+                  (T.fromLitString T.mkNoSrcPos p "WriteMode") p)) p))+          (T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.galt T.mkNoSrcPos p)+            (T.uwrapForward p+              (Hat.Prelude.hreadParen+                (T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse)+                (T.uwrapForward p+                  (Hat.PreludeBasic.hthenLex+                    (T.uap1 T.mkNoSrcPos p+                      (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                      (T.con0 T.mkNoSrcPos p AppendMode aAppendMode))+                    (T.fromLitString T.mkNoSrcPos p "AppendMode") p)) p))+            (T.uwrapForward p+              (Hat.Prelude.hreadParen+                (T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse)+                (T.uwrapForward p+                  (Hat.PreludeBasic.hthenLex+                    (T.uap1 T.mkNoSrcPos p+                      (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                      (T.con0 T.mkNoSrcPos p ReadWriteMode aReadWriteMode))+                    (T.fromLitString T.mkNoSrcPos p "ReadWriteMode") p)) p))))+    +  ++instance Show (IOMode)+  where+  +  gshowsPrec pshowsPrec p =+    T.ufun2 a6v66v6v69showsPrec pshowsPrec p hshowsPrec+    where+    +    hshowsPrec fy1 (T.R (ReadMode) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "ReadMode")+    hshowsPrec fy1 (T.R (WriteMode) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "WriteMode")+    hshowsPrec fy1 (T.R (AppendMode) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "AppendMode")+    hshowsPrec fy1 (T.R (ReadWriteMode) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "ReadWriteMode")+    hshowsPrec _ _ p = T.fatal p+    +  ++data BufferMode =+  NoBuffering  | LineBuffering  | BlockBuffering (T.R (Maybe Int))++instance T.WrapVal (BufferMode)+  where+  +  wrapVal pwrapVal (kwrapVal@NoBuffering) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aNoBuffering)+  wrapVal pwrapVal (kwrapVal@LineBuffering) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aLineBuffering)+  wrapVal pwrapVal (kwrapVal@(BlockBuffering (T.R _ z1wrapVal))) p =+    T.R kwrapVal (T.mkValueApp1 p pwrapVal aBlockBuffering z1wrapVal)+  ++instance Eq (BufferMode)+  where+  +  (!==) (%==) p =+    T.ufun2 (+>=%$=>=%%==) (%==) p (*==)+    where+    +    (*==) (T.R NoBuffering _) (T.R NoBuffering _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R LineBuffering _) (T.R LineBuffering _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R (BlockBuffering fy1) _) (T.R (BlockBuffering fy2) _) p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fy1 fy2+    (*==) _ _ p = T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse+    +  ++instance Ord (BufferMode)+  where+  +  gcompare pcompare p =+    T.ufun2 a9v36v9v38compare pcompare p hcompare+    where+    +    hcompare (T.R (BlockBuffering fy3) _) (T.R (BlockBuffering fy4) _) p =+      T.uap2 T.mkNoSrcPos p (Hat.Prelude.gcompare T.mkNoSrcPos p) fy3 fy4+    hcompare fy1 fy2 p =+      T.uap2 T.mkNoSrcPos p (Hat.Prelude.gcompare T.mkNoSrcPos p)+        (T.uwrapForward p (hlocalFromEnum fy1 p) :: T.R Hat.Prelude.Int)+        (T.uwrapForward p (hlocalFromEnum fy2 p))+      where+      +      glocalFromEnum plocalFromEnum p =+        T.ufun1 a9v36v9v38localFromEnum plocalFromEnum p hlocalFromEnum+      +      alocalFromEnum = a9v36v9v38localFromEnum+      +      hlocalFromEnum (T.R (NoBuffering) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0)+      hlocalFromEnum (T.R (LineBuffering) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 1)+      hlocalFromEnum (T.R (BlockBuffering _) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 2)+      hlocalFromEnum _ p = T.fatal p+      +    +  ++instance Read (BufferMode)+  where+  +  greadsPrec preadsPrec p =+    T.ufun1 a9v41v9v44readsPrec preadsPrec p hreadsPrec+    where+    +    hreadsPrec fy1 p =+      T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.galt T.mkNoSrcPos p)+        (T.uwrapForward p+          (Hat.Prelude.hreadParen+            (T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse)+            (T.uwrapForward p+              (Hat.PreludeBasic.hthenLex+                (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                  (T.con0 T.mkNoSrcPos p NoBuffering aNoBuffering))+                (T.fromLitString T.mkNoSrcPos p "NoBuffering") p)) p))+        (T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.galt T.mkNoSrcPos p)+          (T.uwrapForward p+            (Hat.Prelude.hreadParen+              (T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse)+              (T.uwrapForward p+                (Hat.PreludeBasic.hthenLex+                  (T.uap1 T.mkNoSrcPos p+                    (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                    (T.con0 T.mkNoSrcPos p LineBuffering aLineBuffering))+                  (T.fromLitString T.mkNoSrcPos p "LineBuffering") p)) p))+          (T.uwrapForward p+            (Hat.Prelude.hreadParen+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!> p) fy1+                (T.uap1 T.mkNoSrcPos p+                  (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                  (T.conInteger T.mkNoSrcPos p 9)))+              (T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.gthenAp T.mkNoSrcPos p)+                (T.uwrapForward p+                  (Hat.PreludeBasic.hthenLex+                    (T.uap1 T.mkNoSrcPos p+                      (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                      (T.pa0 BlockBuffering T.cn1 T.mkNoSrcPos p+                        aBlockBuffering))+                    (T.fromLitString T.mkNoSrcPos p "BlockBuffering") p))+                (T.uap1 T.mkNoSrcPos p (Hat.Prelude.greadsPrec T.mkNoSrcPos p)+                  (T.uap1 T.mkNoSrcPos p+                    (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                    (T.conInteger T.mkNoSrcPos p 10)))) p)))+    +  ++instance Show (BufferMode)+  where+  +  gshowsPrec pshowsPrec p =+    T.ufun2 a9v47v9v50showsPrec pshowsPrec p hshowsPrec+    where+    +    hshowsPrec fy1 (T.R (NoBuffering) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "NoBuffering")+    hshowsPrec fy1 (T.R (LineBuffering) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "LineBuffering")+    hshowsPrec fy1 (T.R (BlockBuffering fy2) _) p =+      T.uwrapForward p+        (Hat.Prelude.hshowParen+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!> p) fy1+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 9)))+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+            (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+              (T.fromLitString T.mkNoSrcPos p "BlockBuffering "))+            (T.uap2 T.mkNoSrcPos p (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+              (T.uap1 T.mkNoSrcPos p+                (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                (T.conInteger T.mkNoSrcPos p 10)) fy2)) p)+    hshowsPrec _ _ p = T.fatal p+    +  ++data SeekMode = AbsoluteSeek  | RelativeSeek  | SeekFromEnd ++instance T.WrapVal (SeekMode)+  where+  +  wrapVal pwrapVal (kwrapVal@AbsoluteSeek) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aAbsoluteSeek)+  wrapVal pwrapVal (kwrapVal@RelativeSeek) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aRelativeSeek)+  wrapVal pwrapVal (kwrapVal@SeekFromEnd) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aSeekFromEnd)+  ++instance Eq (SeekMode)+  where+  +  (!==) (%==) p =+    T.ufun2 (+##=%$=##=%%==) (%==) p (*==)+    where+    +    (*==) (T.R AbsoluteSeek _) (T.R AbsoluteSeek _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R RelativeSeek _) (T.R RelativeSeek _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R SeekFromEnd _) (T.R SeekFromEnd _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) _ _ p = T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse+    +  ++instance Ord (SeekMode)+  where+  +  gcompare pcompare p =+    T.ufun2 a11v36v11v38compare pcompare p hcompare+    where+    +    hcompare fy1 fy2 p =+      T.uap2 T.mkNoSrcPos p (Hat.Prelude.gcompare T.mkNoSrcPos p)+        (T.uwrapForward p (hlocalFromEnum fy1 p) :: T.R Hat.Prelude.Int)+        (T.uwrapForward p (hlocalFromEnum fy2 p))+      where+      +      glocalFromEnum plocalFromEnum p =+        T.ufun1 a11v36v11v38localFromEnum plocalFromEnum p hlocalFromEnum+      +      alocalFromEnum = a11v36v11v38localFromEnum+      +      hlocalFromEnum (T.R (AbsoluteSeek) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0)+      hlocalFromEnum (T.R (RelativeSeek) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 1)+      hlocalFromEnum (T.R (SeekFromEnd) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 2)+      hlocalFromEnum _ p = T.fatal p+      +    +  ++instance Ix (SeekMode)+  where+  +  grange prange p =+    T.ufun1 a11v41v11v42range prange p hrange+    where+    +    hrange (T.R (T.Tuple2 fy1 fy2) _) p =+      T.uwrapForward p+        (Hat.PreludeBasic.hmap (glocalToEnum T.mkNoSrcPos p)+          (T.uap2 T.mkNoSrcPos p (Hat.Prelude.genumFromTo T.mkNoSrcPos p)+            (T.uwrapForward p (hlocalFromEnum fy1 p))+            (T.uwrapForward p (hlocalFromEnum fy2 p))) p)+      where+      +      glocalToEnum ::+        T.RefSrcPos -> T.RefExp -> T.R (T.Fun Hat.Prelude.Int SeekMode)+      +      hlocalToEnum :: (T.R Hat.Prelude.Int) -> T.RefExp -> T.R SeekMode+      +      glocalToEnum plocalToEnum p =+        T.ufun1 a11v41v11v42localToEnum plocalToEnum p hlocalToEnum+      +      alocalToEnum = a11v41v11v42localToEnum+      +      hlocalToEnum fv11v41v11v42n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv11v41v11v42n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 0))) (h p)+          (y1localToEnum fv11v41v11v42n p)+        where+        +        h p = T.con0 T.mkNoSrcPos p AbsoluteSeek aAbsoluteSeek+        h p = y1localToEnum fv11v41v11v42n p+        +      hlocalToEnum fv11v41v11v42n p = y1localToEnum fv11v41v11v42n p+      +      y1localToEnum fv11v41v11v42n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv11v41v11v42n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 1))) (h p)+          (y2localToEnum fv11v41v11v42n p)+        where+        +        h p = T.con0 T.mkNoSrcPos p RelativeSeek aRelativeSeek+        h p = y2localToEnum fv11v41v11v42n p+        +      y1localToEnum fv11v41v11v42n p = y2localToEnum fv11v41v11v42n p+      +      y2localToEnum fv11v41v11v42n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv11v41v11v42n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 2))) (h p) (T.fatal p)+        where+        +        h p = T.con0 T.mkNoSrcPos p SeekFromEnd aSeekFromEnd+        h p = T.fatal p+        +      y2localToEnum _ p = T.fatal p+      +      glocalFromEnum ::+        T.RefSrcPos -> T.RefExp -> T.R (T.Fun SeekMode Hat.Prelude.Int)+      +      hlocalFromEnum :: (T.R SeekMode) -> T.RefExp -> T.R Hat.Prelude.Int+      +      glocalFromEnum plocalFromEnum p =+        T.ufun1 a11v41v11v42localFromEnum plocalFromEnum p hlocalFromEnum+      +      alocalFromEnum = a11v41v11v42localFromEnum+      +      hlocalFromEnum (T.R AbsoluteSeek _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0)+      hlocalFromEnum (T.R RelativeSeek _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 1)+      hlocalFromEnum (T.R SeekFromEnd _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 2)+      hlocalFromEnum _ p = T.fatal p+      +    hrange _ p = T.fatal p+    +  +  gindex pindex p =+    T.ufun2 a11v41v11v42index pindex p hindex+    where+    +    hindex (T.R (T.Tuple2 fy1 fy2) _) fy3 p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!- p)+        (T.uwrapForward p (hlocalFromEnum fy3 p))+        (T.uwrapForward p (hlocalFromEnum fy1 p))+      where+      +      glocalFromEnum ::+        T.RefSrcPos -> T.RefExp -> T.R (T.Fun SeekMode Hat.Prelude.Int)+      +      hlocalFromEnum :: (T.R SeekMode) -> T.RefExp -> T.R Hat.Prelude.Int+      +      glocalFromEnum plocalFromEnum p =+        T.ufun1 a11v41v11v42localFromEnum plocalFromEnum p hlocalFromEnum+      +      alocalFromEnum = a11v41v11v42localFromEnum+      +      hlocalFromEnum (T.R AbsoluteSeek _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0)+      hlocalFromEnum (T.R RelativeSeek _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 1)+      hlocalFromEnum (T.R SeekFromEnd _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 2)+      hlocalFromEnum _ p = T.fatal p+      +    hindex _ _ p = T.fatal p+    +  +  ginRange pinRange p =+    T.ufun2 a11v41v11v42inRange pinRange p hinRange+    where+    +    hinRange (T.R (T.Tuple2 fy1 fy2) _) fy3 p =+      T.uap2 T.mkNoSrcPos p (Hat.Ix.ginRange T.mkNoSrcPos p)+        (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+          (T.uwrapForward p (hlocalFromEnum fy1 p))+          (T.uwrapForward p (hlocalFromEnum fy2 p)))+        (T.uwrapForward p (hlocalFromEnum fy3 p))+      where+      +      glocalFromEnum ::+        T.RefSrcPos -> T.RefExp -> T.R (T.Fun SeekMode Hat.Prelude.Int)+      +      hlocalFromEnum :: (T.R SeekMode) -> T.RefExp -> T.R Hat.Prelude.Int+      +      glocalFromEnum plocalFromEnum p =+        T.ufun1 a11v41v11v42localFromEnum plocalFromEnum p hlocalFromEnum+      +      alocalFromEnum = a11v41v11v42localFromEnum+      +      hlocalFromEnum (T.R AbsoluteSeek _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0)+      hlocalFromEnum (T.R RelativeSeek _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 1)+      hlocalFromEnum (T.R SeekFromEnd _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 2)+      hlocalFromEnum _ p = T.fatal p+      +    hinRange _ _ p = T.fatal p+    +  ++instance Bounded (SeekMode)+  where+  +  gminBound pminBound p = T.uconstUse pminBound p sminBound+  +  sminBound =+    T.uconstDef T.mkRoot a11v45v11v51minBound+      (\ p -> T.con0 T.mkNoSrcPos p AbsoluteSeek aAbsoluteSeek)+  +  gmaxBound pmaxBound p = T.uconstUse pmaxBound p smaxBound+  +  smaxBound =+    T.uconstDef T.mkRoot a11v45v11v51maxBound+      (\ p -> T.con0 T.mkNoSrcPos p SeekFromEnd aSeekFromEnd)+  ++instance Enum (SeekMode)+  where+  +  gfromEnum pfromEnum p =+    T.ufun1 a11v54v11v57fromEnum pfromEnum p hfromEnum+    where+    +    hfromEnum (T.R AbsoluteSeek _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 0)+    hfromEnum (T.R RelativeSeek _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 1)+    hfromEnum (T.R SeekFromEnd _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 2)+    hfromEnum _ p = T.fatal p+    +  +  gtoEnum ptoEnum p =+    T.ufun1 a11v54v11v57toEnum ptoEnum p htoEnum+    where+    +    htoEnum fv11v54v11v57n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv11v54v11v57n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 0))) (h p) (y1toEnum fv11v54v11v57n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p AbsoluteSeek aAbsoluteSeek+      h p = y1toEnum fv11v54v11v57n p+      +    htoEnum fv11v54v11v57n p = y1toEnum fv11v54v11v57n p+    +    y1toEnum fv11v54v11v57n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv11v54v11v57n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 1))) (h p) (y2toEnum fv11v54v11v57n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p RelativeSeek aRelativeSeek+      h p = y2toEnum fv11v54v11v57n p+      +    y1toEnum fv11v54v11v57n p = y2toEnum fv11v54v11v57n p+    +    y2toEnum fv11v54v11v57n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv11v54v11v57n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 2))) (h p) (y3toEnum fv11v54v11v57n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p SeekFromEnd aSeekFromEnd+      h p = y3toEnum fv11v54v11v57n p+      +    y2toEnum fv11v54v11v57n p = y3toEnum fv11v54v11v57n p+    +    y3toEnum _ p =+      T.uwrapForward p+        (Hat.Prelude.herror+          (T.fromLitString T.mkNoSrcPos p "toEnum: argument out of bounds") p)+    +  +  genumFrom penumFrom p =+    T.ufun1 a11v54v11v57enumFrom penumFrom p henumFrom+    where+    +    henumFrom fy1 p =+      T.uap2 T.mkNoSrcPos p (Hat.Prelude.genumFromTo T.mkNoSrcPos p) fy1+        (T.con0 T.mkNoSrcPos p SeekFromEnd aSeekFromEnd)+    +  +  genumFromThen penumFromThen p =+    T.ufun2 a11v54v11v57enumFromThen penumFromThen p henumFromThen+    where+    +    henumFromThen fy1 fy2 p =+      T.uap3 T.mkNoSrcPos p (Hat.Prelude.genumFromThenTo T.mkNoSrcPos p) fy1 fy2+        (T.ucif p+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>= p)+            (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gfromEnum T.mkNoSrcPos p) fy1)+            (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gfromEnum T.mkNoSrcPos p) fy2))+          (T.con0 T.mkNoSrcPos p SeekFromEnd aSeekFromEnd)+          (T.con0 T.mkNoSrcPos p AbsoluteSeek aAbsoluteSeek))+    +  ++instance Read (SeekMode)+  where+  +  greadsPrec preadsPrec p =+    T.ufun1 a11v60v11v63readsPrec preadsPrec p hreadsPrec+    where+    +    hreadsPrec fy1 p =+      T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.galt T.mkNoSrcPos p)+        (T.uwrapForward p+          (Hat.Prelude.hreadParen+            (T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse)+            (T.uwrapForward p+              (Hat.PreludeBasic.hthenLex+                (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                  (T.con0 T.mkNoSrcPos p AbsoluteSeek aAbsoluteSeek))+                (T.fromLitString T.mkNoSrcPos p "AbsoluteSeek") p)) p))+        (T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.galt T.mkNoSrcPos p)+          (T.uwrapForward p+            (Hat.Prelude.hreadParen+              (T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse)+              (T.uwrapForward p+                (Hat.PreludeBasic.hthenLex+                  (T.uap1 T.mkNoSrcPos p+                    (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                    (T.con0 T.mkNoSrcPos p RelativeSeek aRelativeSeek))+                  (T.fromLitString T.mkNoSrcPos p "RelativeSeek") p)) p))+          (T.uwrapForward p+            (Hat.Prelude.hreadParen+              (T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse)+              (T.uwrapForward p+                (Hat.PreludeBasic.hthenLex+                  (T.uap1 T.mkNoSrcPos p+                    (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                    (T.con0 T.mkNoSrcPos p SeekFromEnd aSeekFromEnd))+                  (T.fromLitString T.mkNoSrcPos p "SeekFromEnd") p)) p)))+    +  ++instance Show (SeekMode)+  where+  +  gshowsPrec pshowsPrec p =+    T.ufun2 a11v66v11v69showsPrec pshowsPrec p hshowsPrec+    where+    +    hshowsPrec fy1 (T.R (AbsoluteSeek) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "AbsoluteSeek")+    hshowsPrec fy1 (T.R (RelativeSeek) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "RelativeSeek")+    hshowsPrec fy1 (T.R (SeekFromEnd) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "SeekFromEnd")+    hshowsPrec _ _ p = T.fatal p+    +  ++tIOBuiltinTypes = T.mkModule "IOBuiltinTypes" "IOBuiltinTypes.hs" Prelude.False++aReadMode = T.mkConstructor tIOBuiltinTypes 50021 50028 3 0 "ReadMode"++aWriteMode = T.mkConstructor tIOBuiltinTypes 50032 50040 3 0 "WriteMode"++aAppendMode = T.mkConstructor tIOBuiltinTypes 50044 50053 3 0 "AppendMode"++aReadWriteMode = T.mkConstructor tIOBuiltinTypes 50057 50069 3 0 "ReadWriteMode"++aNoBuffering = T.mkConstructor tIOBuiltinTypes 70021 70031 3 0 "NoBuffering"++aLineBuffering = T.mkConstructor tIOBuiltinTypes 70035 70047 3 0 "LineBuffering"++aBlockBuffering =+  T.mkConstructor tIOBuiltinTypes 80022 80035 3 1 "BlockBuffering"++aAbsoluteSeek = T.mkConstructor tIOBuiltinTypes 100021 100032 3 0 "AbsoluteSeek"++aRelativeSeek = T.mkConstructor tIOBuiltinTypes 100036 100047 3 0 "RelativeSeek"++aSeekFromEnd = T.mkConstructor tIOBuiltinTypes 100051 100061 3 0 "SeekFromEnd"++(++=%$=+=%%==) = T.mkVariable tIOBuiltinTypes 60032 60033 3 2 "==" Prelude.False++a6v36v6v38compare =+  T.mkVariable tIOBuiltinTypes 60036 60038 3 2 "compare" Prelude.False++a6v41v6v42range =+  T.mkVariable tIOBuiltinTypes 60041 60042 3 1 "range" Prelude.False++a6v41v6v42index =+  T.mkVariable tIOBuiltinTypes 60041 60042 3 2 "index" Prelude.False++a6v41v6v42inRange =+  T.mkVariable tIOBuiltinTypes 60041 60042 3 2 "inRange" Prelude.False++a6v45v6v51minBound =+  T.mkVariable tIOBuiltinTypes 60045 60051 3 0 "minBound" Prelude.False++a6v45v6v51maxBound =+  T.mkVariable tIOBuiltinTypes 60045 60051 3 0 "maxBound" Prelude.False++a6v54v6v57fromEnum =+  T.mkVariable tIOBuiltinTypes 60054 60057 3 1 "fromEnum" Prelude.False++a6v54v6v57toEnum =+  T.mkVariable tIOBuiltinTypes 60054 60057 3 1 "toEnum" Prelude.False++a6v54v6v57enumFrom =+  T.mkVariable tIOBuiltinTypes 60054 60057 3 1 "enumFrom" Prelude.False++a6v54v6v57enumFromThen =+  T.mkVariable tIOBuiltinTypes 60054 60057 3 2 "enumFromThen" Prelude.False++a6v60v6v63readsPrec =+  T.mkVariable tIOBuiltinTypes 60060 60063 3 1 "readsPrec" Prelude.False++a6v66v6v69showsPrec =+  T.mkVariable tIOBuiltinTypes 60066 60069 3 2 "showsPrec" Prelude.False++(+>=%$=>=%%==) = T.mkVariable tIOBuiltinTypes 90032 90033 3 2 "==" Prelude.False++a9v36v9v38compare =+  T.mkVariable tIOBuiltinTypes 90036 90038 3 2 "compare" Prelude.False++a9v41v9v44readsPrec =+  T.mkVariable tIOBuiltinTypes 90041 90044 3 1 "readsPrec" Prelude.False++a9v47v9v50showsPrec =+  T.mkVariable tIOBuiltinTypes 90047 90050 3 2 "showsPrec" Prelude.False++(+##=%$=##=%%==) =+  T.mkVariable tIOBuiltinTypes 110032 110033 3 2 "==" Prelude.False++a11v36v11v38compare =+  T.mkVariable tIOBuiltinTypes 110036 110038 3 2 "compare" Prelude.False++a11v41v11v42range =+  T.mkVariable tIOBuiltinTypes 110041 110042 3 1 "range" Prelude.False++a11v41v11v42index =+  T.mkVariable tIOBuiltinTypes 110041 110042 3 2 "index" Prelude.False++a11v41v11v42inRange =+  T.mkVariable tIOBuiltinTypes 110041 110042 3 2 "inRange" Prelude.False++a11v45v11v51minBound =+  T.mkVariable tIOBuiltinTypes 110045 110051 3 0 "minBound" Prelude.False++a11v45v11v51maxBound =+  T.mkVariable tIOBuiltinTypes 110045 110051 3 0 "maxBound" Prelude.False++a11v54v11v57fromEnum =+  T.mkVariable tIOBuiltinTypes 110054 110057 3 1 "fromEnum" Prelude.False++a11v54v11v57toEnum =+  T.mkVariable tIOBuiltinTypes 110054 110057 3 1 "toEnum" Prelude.False++a11v54v11v57enumFrom =+  T.mkVariable tIOBuiltinTypes 110054 110057 3 1 "enumFrom" Prelude.False++a11v54v11v57enumFromThen =+  T.mkVariable tIOBuiltinTypes 110054 110057 3 2 "enumFromThen" Prelude.False++a11v60v11v63readsPrec =+  T.mkVariable tIOBuiltinTypes 110060 110063 3 1 "readsPrec" Prelude.False++a11v66v11v69showsPrec =+  T.mkVariable tIOBuiltinTypes 110066 110069 3 2 "showsPrec" Prelude.False++a6v36v6v38localFromEnum =+  T.mkVariable tIOBuiltinTypes 60036 60038 3 1 "localFromEnum" Prelude.True++a6v41v6v42localToEnum =+  T.mkVariable tIOBuiltinTypes 60041 60042 3 1 "localToEnum" Prelude.True++a6v41v6v42localFromEnum =+  T.mkVariable tIOBuiltinTypes 60041 60042 3 1 "localFromEnum" Prelude.True++a9v36v9v38localFromEnum =+  T.mkVariable tIOBuiltinTypes 90036 90038 3 1 "localFromEnum" Prelude.True++a11v36v11v38localFromEnum =+  T.mkVariable tIOBuiltinTypes 110036 110038 3 1 "localFromEnum" Prelude.True++a11v41v11v42localToEnum =+  T.mkVariable tIOBuiltinTypes 110041 110042 3 1 "localToEnum" Prelude.True++a11v41v11v42localFromEnum =+  T.mkVariable tIOBuiltinTypes 110041 110042 3 1 "localFromEnum" Prelude.True
+ Hat/Ix.hs view
@@ -0,0 +1,6997 @@+module Hat.Ix+  (Ix(grange,gindex,ginRange,grangeSize,srange,sindex,sinRange+      ,srangeSize)) where++import qualified Hat.PreludeBasic +import qualified Prelude +import Hat.Hack +import qualified Hat.Hat as T +import Hat.Hat  (WrapVal(wrapVal))+import Hat.Prelude ++class Ord a => Ix a+  where+  +  grange :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun (T.Tuple2 a a) (T.List a))+  +  gindex :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun (T.Tuple2 a a) (T.Fun a Int))+  +  ginRange ::+    T.RefSrcPos -> T.RefExp -> T.R (T.Fun (T.Tuple2 a a) (T.Fun a Bool))+  +  grangeSize :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun (T.Tuple2 a a) Int)+  +  grangeSize prangeSize p =+    T.ufun1 a9v5v10v54rangeSize prangeSize p hrangeSize+    where+    +    hrangeSize (fb@(T.R (T.Tuple2 fl fh) _)) p =+      T.ucguard+        (T.uwrapForward p+          (hnull (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p) fb) p))+        (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0))+        (T.ucguard (gotherwise T.mkNoSrcPos p)+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+            (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p) fb fh)+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 1))) (T.fatal p))+    hrangeSize _ p = T.fatal p+    +  +  srange :: T.R (T.Fun (T.Tuple2 a a) (T.List a))+  +  sindex :: T.R (T.Fun (T.Tuple2 a a) (T.Fun a Int))+  +  sinRange :: T.R (T.Fun (T.Tuple2 a a) (T.Fun a Bool))+  +  srangeSize :: T.R (T.Fun (T.Tuple2 a a) Int)+  ++instance Ix (Char)+  where+  +  grange prange p =+    T.ufun1 a18v5v18v19range prange p hrange+    where+    +    hrange (T.R (T.Tuple2 fm fn) _) p =+      T.uap2 T.mkNoSrcPos p (Hat.Prelude.genumFromTo T.mkNoSrcPos p) fm fn+    hrange _ p = T.fatal p+    +  +  gindex pindex p =+    T.ufun2 a19v5v21v64index pindex p hindex+    where+    +    hindex (fb@(T.R (T.Tuple2 fc fc') _)) fci p =+      T.ucguard (T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p) fb fci)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !- p)+          (T.uap1 T.mkNoSrcPos p (gfromEnum T.mkNoSrcPos p) fci)+          (T.uap1 T.mkNoSrcPos p (gfromEnum T.mkNoSrcPos p) fc))+        (T.ucguard (gotherwise T.mkNoSrcPos p)+          (T.uwrapForward p+            (herror+              (T.fromLitString T.mkNoSrcPos p "Ix.index: Index out of range.")+              p)) (T.fatal p))+    hindex _ _ p = T.fatal p+    +  +  ginRange pinRange p =+    T.ufun2 a22v5v22v44inRange pinRange p hinRange+    where+    +    hinRange (T.R (T.Tuple2 fc fc') _) fi p =+      T.uwrapForward p+        (((T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !<= p) fc fi)+            *&&+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !<= p) fi fc')) p)+    hinRange _ _ p = T.fatal p+    +  ++instance Ix (Int)+  where+  +  grange prange p =+    T.ufun1 a25v5v25v19range prange p hrange+    where+    +    hrange (T.R (T.Tuple2 fm fn) _) p =+      T.uap2 T.mkNoSrcPos p (Hat.Prelude.genumFromTo T.mkNoSrcPos p) fm fn+    hrange _ p = T.fatal p+    +  +  gindex pindex p =+    T.ufun2 a26v5v28v64index pindex p hindex+    where+    +    hindex (fb@(T.R (T.Tuple2 fm fn) _)) fi p =+      T.ucguard (T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p) fb fi)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !- p) fi fm)+        (T.ucguard (gotherwise T.mkNoSrcPos p)+          (T.uwrapForward p+            (herror+              (T.fromLitString T.mkNoSrcPos p "Ix.index: Index out of range.")+              p)) (T.fatal p))+    hindex _ _ p = T.fatal p+    +  +  ginRange pinRange p =+    T.ufun2 a29v5v29v43inRange pinRange p hinRange+    where+    +    hinRange (T.R (T.Tuple2 fm fn) _) fi p =+      T.uwrapForward p+        (((T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !<= p) fm fi)+            *&&+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !<= p) fi fn)) p)+    hinRange _ _ p = T.fatal p+    +  ++instance Ix (Integer)+  where+  +  grange prange p =+    T.ufun1 a32v5v32v19range prange p hrange+    where+    +    hrange (T.R (T.Tuple2 fm fn) _) p =+      T.uap2 T.mkNoSrcPos p (Hat.Prelude.genumFromTo T.mkNoSrcPos p) fm fn+    hrange _ p = T.fatal p+    +  +  gindex pindex p =+    T.ufun2 a33v5v35v64index pindex p hindex+    where+    +    hindex (fb@(T.R (T.Tuple2 fm fn) _)) fi p =+      T.ucguard (T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p) fb fi)+        (T.uap1 T.mkNoSrcPos p (gfromInteger T.mkNoSrcPos p)+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !- p) fi fm))+        (T.ucguard (gotherwise T.mkNoSrcPos p)+          (T.uwrapForward p+            (herror+              (T.fromLitString T.mkNoSrcPos p "Ix.index: Index out of range.")+              p)) (T.fatal p))+    hindex _ _ p = T.fatal p+    +  +  ginRange pinRange p =+    T.ufun2 a36v5v36v43inRange pinRange p hinRange+    where+    +    hinRange (T.R (T.Tuple2 fm fn) _) fi p =+      T.uwrapForward p+        (((T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !<= p) fm fi)+            *&&+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !<= p) fi fn)) p)+    hinRange _ _ p = T.fatal p+    +  ++instance Ix (Bool)+  where+  +  grange prange p =+    T.ufun1 a39v3v39v19range prange p hrange+    where+    +    hrange (T.R (T.Tuple2 fc fc') _) p =+      T.uap2 T.mkNoSrcPos p (Hat.Prelude.genumFromTo T.mkNoSrcPos p) fc fc'+    hrange _ p = T.fatal p+    +  +  gindex pindex p =+    T.ufun2 a41v3v43v67index pindex p hindex+    where+    +    hindex (fb@(T.R (T.Tuple2 fc fc') _)) fci p =+      T.ucguard (T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p) fb fci)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !- p)+          (T.uap1 T.mkNoSrcPos p (gfromEnum T.mkNoSrcPos p) fci)+          (T.uap1 T.mkNoSrcPos p (gfromEnum T.mkNoSrcPos p) fc))+        (T.ucguard (T.con0 T.mkNoSrcPos p True aTrue)+          (T.uwrapForward p+            (herror+              (T.fromLitString T.mkNoSrcPos p+                "Ix.Bool.index: Index out of range.") p)) (T.fatal p))+    hindex _ _ p = T.fatal p+    +  +  ginRange pinRange p =+    T.ufun2 a44v3v44v44inRange pinRange p hinRange+    where+    +    hinRange (T.R (T.Tuple2 fc fc') _) fci p =+      T.uwrapForward p+        (((T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !<= p) fc fci)+            *&&+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !<= p) fci fc')) p)+    hinRange _ _ p = T.fatal p+    +  ++instance Ix (Ordering)+  where+  +  grange prange p =+    T.ufun1 a48v3v48v19range prange p hrange+    where+    +    hrange (T.R (T.Tuple2 fc fc') _) p =+      T.uap2 T.mkNoSrcPos p (Hat.Prelude.genumFromTo T.mkNoSrcPos p) fc fc'+    hrange _ p = T.fatal p+    +  +  gindex pindex p =+    T.ufun2 a50v3v52v71index pindex p hindex+    where+    +    hindex (fb@(T.R (T.Tuple2 fc fc') _)) fci p =+      T.ucguard (T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p) fb fci)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !- p)+          (T.uap1 T.mkNoSrcPos p (gfromEnum T.mkNoSrcPos p) fci)+          (T.uap1 T.mkNoSrcPos p (gfromEnum T.mkNoSrcPos p) fc))+        (T.ucguard (T.con0 T.mkNoSrcPos p True aTrue)+          (T.uwrapForward p+            (herror+              (T.fromLitString T.mkNoSrcPos p+                "Ix.Ordering.index: Index out of range.") p)) (T.fatal p))+    hindex _ _ p = T.fatal p+    +  +  ginRange pinRange p =+    T.ufun2 a53v3v53v44inRange pinRange p hinRange+    where+    +    hinRange (T.R (T.Tuple2 fc fc') _) fci p =+      T.uwrapForward p+        (((T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !<= p) fc fci)+            *&&+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !<= p) fci fc')) p)+    hinRange _ _ p = T.fatal p+    +  ++instance Ix (T.Tuple0)+  where+  +  grange prange p =+    T.ufun1 a57v3v57v25range prange p hrange+    where+    +    hrange (T.R (T.Tuple2 (T.R T.Tuple0 _) (T.R T.Tuple0 _)) _) p =+      T.fromExpList T.mkNoSrcPos p [T.con0 T.mkNoSrcPos p T.Tuple0 T.aTuple0]+    hrange _ p = T.fatal p+    +  +  gindex pindex p =+    T.ufun2 a58v3v58v25index pindex p hindex+    where+    +    hindex (T.R (T.Tuple2 (T.R T.Tuple0 _) (T.R T.Tuple0 _)) _) (T.R T.Tuple0 _)+      p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 0)+    hindex _ _ p = T.fatal p+    +  +  ginRange pinRange p =+    T.ufun2 a59v3v59v30inRange pinRange p hinRange+    where+    +    hinRange (T.R (T.Tuple2 (T.R T.Tuple0 _) (T.R T.Tuple0 _)) _)+      (T.R T.Tuple0 _) p =+      T.con0 T.mkNoSrcPos p True aTrue+    hinRange _ _ p = T.fatal p+    +  ++instance (Ix a,Ix b) => Ix ((T.Tuple2 a b))+  where+  +  grange prange p =+    T.ufun1 a62v10v62v14range prange p hrange+    where+    +    hrange+      (T.R (T.Tuple2 (T.R (T.Tuple2 fl fl') _) (T.R (T.Tuple2 fu fu') _)) _) p =+      T.uap1 T.mkNoSrcPos p+        (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+          (T.ufun2 T.mkLambda T.mkNoSrcPos p+            (\ f_x f_y p ->+              T.uccase T.mkNoSrcPos p+                (let+                  v0v0v0v0v1 fi p =+                    T.uap1 T.mkNoSrcPos p+                      (T.uap2 T.mkNoSrcPos p+                        (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                        (T.ufun2 T.mkLambda T.mkNoSrcPos p+                          (\ f_x f_y p ->+                            T.uccase T.mkNoSrcPos p+                              (let+                                v0v0v0v0v1 fi' p =+                                  T.uap1 T.mkNoSrcPos p+                                    (T.pa1 T.Cons T.cn1 T.mkNoSrcPos p T.aCons+                                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                        fi fi')) f_y+                                v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y+                                in (v0v0v0v0v1)) f_x))+                        (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl' fu')))+                      f_y+                  v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in+                  (v0v0v0v0v1)) f_x))+          (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl fu)))+        (T.fromExpList T.mkNoSrcPos p [])+    hrange _ p = T.fatal p+    +  +  gindex pindex p =+    T.ufun2 a64v10v65v72index pindex p hindex+    where+    +    hindex+      (T.R (T.Tuple2 (T.R (T.Tuple2 fl fl') _) (T.R (T.Tuple2 fu fu') _)) _)+      (T.R (T.Tuple2 fi fi') _) p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+          (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl fu) fi)+          (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl' fu')))+        (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl' fu') fi')+    hindex _ _ p = T.fatal p+    +  +  ginRange pinRange p =+    T.ufun2 a66v10v67v56inRange pinRange p hinRange+    where+    +    hinRange+      (T.R (T.Tuple2 (T.R (T.Tuple2 fl fl') _) (T.R (T.Tuple2 fu fu') _)) _)+      (T.R (T.Tuple2 fi fi') _) p =+      T.uwrapForward p+        (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl fu) fi)+            *&&+            (T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl' fu') fi')) p)+    hinRange _ _ p = T.fatal p+    +  ++instance (Ix a1,Ix a2,Ix a3) => Ix ((T.Tuple3 a1 a2 a3))+  where+  +  grange prange p =+    T.ufun1 a70v5v70v9range prange p hrange+    where+    +    hrange+      (T.R+        (T.Tuple2 (T.R (T.Tuple3 fl1 fl2 fl3) _) (T.R (T.Tuple3 fu1 fu2 fu3) _))+        _) p =+      T.uap1 T.mkNoSrcPos p+        (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+          (T.ufun2 T.mkLambda T.mkNoSrcPos p+            (\ f_x f_y p ->+              T.uccase T.mkNoSrcPos p+                (let+                  v0v0v0v0v1 fi1 p =+                    T.uap1 T.mkNoSrcPos p+                      (T.uap2 T.mkNoSrcPos p+                        (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                        (T.ufun2 T.mkLambda T.mkNoSrcPos p+                          (\ f_x f_y p ->+                            T.uccase T.mkNoSrcPos p+                              (let+                                v0v0v0v0v1 fi2 p =+                                  T.uap1 T.mkNoSrcPos p+                                    (T.uap2 T.mkNoSrcPos p+                                      (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                                      (T.ufun2 T.mkLambda T.mkNoSrcPos p+                                        (\ f_x f_y p ->+                                          T.uccase T.mkNoSrcPos p+                                            (let+                                              v0v0v0v0v1 fi3 p =+                                                T.uap1 T.mkNoSrcPos p+                                                  (T.pa1 T.Cons T.cn1+                                                    T.mkNoSrcPos p T.aCons+                                                    (T.con3 T.mkNoSrcPos p+                                                      T.Tuple3 T.aTuple3 fi1 fi2+                                                      fi3)) f_y+                                              v0v0v0v0v1 _ p =+                                                T.projection T.mkNoSrcPos p f_y+                                              in (v0v0v0v0v1)) f_x))+                                      (T.uap1 T.mkNoSrcPos p+                                        (grange T.mkNoSrcPos p)+                                        (T.con2 T.mkNoSrcPos p T.Tuple2+                                          T.aTuple2 fl3 fu3))) f_y+                                v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y+                                in (v0v0v0v0v1)) f_x))+                        (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2)))+                      f_y+                  v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in+                  (v0v0v0v0v1)) f_x))+          (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1)))+        (T.fromExpList T.mkNoSrcPos p [])+    hrange _ p = T.fatal p+    +  +  gindex pindex p =+    T.ufun2 a75v5v78v27index pindex p hindex+    where+    +    hindex+      (T.R+        (T.Tuple2 (T.R (T.Tuple3 fl1 fl2 fl3) _) (T.R (T.Tuple3 fu1 fu2 fu3) _))+        _) (T.R (T.Tuple3 fi1 fi2 fi3) _) p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+        (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3 fu3) fi3)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+          (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3 fu3))+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+            (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2) fi2)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+              (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2))+              (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1) fi1))))+    hindex _ _ p = T.fatal p+    +  +  ginRange pinRange p =+    T.ufun2 a80v5v83v32inRange pinRange p hinRange+    where+    +    hinRange+      (T.R+        (T.Tuple2 (T.R (T.Tuple3 fl1 fl2 fl3) _) (T.R (T.Tuple3 fu1 fu2 fu3) _))+        _) (T.R (T.Tuple3 fi1 fi2 fi3) _) p =+      T.uwrapForward p+        (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1) fi1)+            *&&+            (T.uwrapForward p+              (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2) fi2)+                  *&&+                  (T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3 fu3) fi3))+                p))) p)+    hinRange _ _ p = T.fatal p+    +  ++instance (Ix a1,Ix a2,Ix a3,Ix a4) => Ix ((T.Tuple4 a1 a2 a3 a4))+  where+  +  grange prange p =+    T.ufun1 a86v5v86v9range prange p hrange+    where+    +    hrange+      (T.R+        (T.Tuple2 (T.R (T.Tuple4 fl1 fl2 fl3 fl4) _)+          (T.R (T.Tuple4 fu1 fu2 fu3 fu4) _)) _) p =+      T.uap1 T.mkNoSrcPos p+        (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+          (T.ufun2 T.mkLambda T.mkNoSrcPos p+            (\ f_x f_y p ->+              T.uccase T.mkNoSrcPos p+                (let+                  v0v0v0v0v1 fi1 p =+                    T.uap1 T.mkNoSrcPos p+                      (T.uap2 T.mkNoSrcPos p+                        (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                        (T.ufun2 T.mkLambda T.mkNoSrcPos p+                          (\ f_x f_y p ->+                            T.uccase T.mkNoSrcPos p+                              (let+                                v0v0v0v0v1 fi2 p =+                                  T.uap1 T.mkNoSrcPos p+                                    (T.uap2 T.mkNoSrcPos p+                                      (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                                      (T.ufun2 T.mkLambda T.mkNoSrcPos p+                                        (\ f_x f_y p ->+                                          T.uccase T.mkNoSrcPos p+                                            (let+                                              v0v0v0v0v1 fi3 p =+                                                T.uap1 T.mkNoSrcPos p+                                                  (T.uap2 T.mkNoSrcPos p+                                                    (Hat.Prelude.g_foldr+                                                      T.mkNoSrcPos p)+                                                    (T.ufun2 T.mkLambda+                                                      T.mkNoSrcPos p+                                                      (\ f_x f_y p ->+                                                        T.uccase T.mkNoSrcPos p+                                                          (let+                                                            v0v0v0v0v1 fi4 p =+                                                              T.uap1+                                                                T.mkNoSrcPos p+                                                                (T.pa1 T.Cons+                                                                  T.cn1+                                                                  T.mkNoSrcPos p+                                                                  T.aCons+                                                                  (T.con4+                                                                    T.mkNoSrcPos+                                                                    p T.Tuple4+                                                                    T.aTuple4+                                                                    fi1 fi2 fi3+                                                                    fi4)) f_y+                                                            v0v0v0v0v1 _ p =+                                                              T.projection+                                                                T.mkNoSrcPos p+                                                                f_y in+                                                            (v0v0v0v0v1)) f_x))+                                                    (T.uap1 T.mkNoSrcPos p+                                                      (grange T.mkNoSrcPos p)+                                                      (T.con2 T.mkNoSrcPos p+                                                        T.Tuple2 T.aTuple2 fl4+                                                        fu4))) f_y+                                              v0v0v0v0v1 _ p =+                                                T.projection T.mkNoSrcPos p f_y+                                              in (v0v0v0v0v1)) f_x))+                                      (T.uap1 T.mkNoSrcPos p+                                        (grange T.mkNoSrcPos p)+                                        (T.con2 T.mkNoSrcPos p T.Tuple2+                                          T.aTuple2 fl3 fu3))) f_y+                                v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y+                                in (v0v0v0v0v1)) f_x))+                        (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2)))+                      f_y+                  v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in+                  (v0v0v0v0v1)) f_x))+          (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1)))+        (T.fromExpList T.mkNoSrcPos p [])+    hrange _ p = T.fatal p+    +  +  gindex pindex p =+    T.ufun2 a92v5v96v29index pindex p hindex+    where+    +    hindex+      (T.R+        (T.Tuple2 (T.R (T.Tuple4 fl1 fl2 fl3 fl4) _)+          (T.R (T.Tuple4 fu1 fu2 fu3 fu4) _)) _)+      (T.R (T.Tuple4 fi1 fi2 fi3 fi4) _) p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+        (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4 fu4) fi4)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+          (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4 fu4))+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+            (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3 fu3) fi3)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+              (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3 fu3))+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                  (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2) fi2)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                  (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2))+                  (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1) fi1))))))+    hindex _ _ p = T.fatal p+    +  +  ginRange pinRange p =+    T.ufun2 a98v5v102v32inRange pinRange p hinRange+    where+    +    hinRange+      (T.R+        (T.Tuple2 (T.R (T.Tuple4 fl1 fl2 fl3 fl4) _)+          (T.R (T.Tuple4 fu1 fu2 fu3 fu4) _)) _)+      (T.R (T.Tuple4 fi1 fi2 fi3 fi4) _) p =+      T.uwrapForward p+        (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1) fi1)+            *&&+            (T.uwrapForward p+              (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2) fi2)+                  *&&+                  (T.uwrapForward p+                    (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3 fu3)+                          fi3)+                        *&&+                        (T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4 fu4)+                          fi4)) p))) p))) p)+    hinRange _ _ p = T.fatal p+    +  ++instance (Ix a1,Ix a2,Ix a3,Ix a4,Ix a5) => Ix ((T.Tuple5 a1 a2 a3 a4 a5))+  where+  +  grange prange p =+    T.ufun1 a106v5v106v9range prange p hrange+    where+    +    hrange+      (T.R+        (T.Tuple2 (T.R (T.Tuple5 fl1 fl2 fl3 fl4 fl5) _)+          (T.R (T.Tuple5 fu1 fu2 fu3 fu4 fu5) _)) _) p =+      T.uap1 T.mkNoSrcPos p+        (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+          (T.ufun2 T.mkLambda T.mkNoSrcPos p+            (\ f_x f_y p ->+              T.uccase T.mkNoSrcPos p+                (let+                  v0v0v0v0v1 fi1 p =+                    T.uap1 T.mkNoSrcPos p+                      (T.uap2 T.mkNoSrcPos p+                        (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                        (T.ufun2 T.mkLambda T.mkNoSrcPos p+                          (\ f_x f_y p ->+                            T.uccase T.mkNoSrcPos p+                              (let+                                v0v0v0v0v1 fi2 p =+                                  T.uap1 T.mkNoSrcPos p+                                    (T.uap2 T.mkNoSrcPos p+                                      (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                                      (T.ufun2 T.mkLambda T.mkNoSrcPos p+                                        (\ f_x f_y p ->+                                          T.uccase T.mkNoSrcPos p+                                            (let+                                              v0v0v0v0v1 fi3 p =+                                                T.uap1 T.mkNoSrcPos p+                                                  (T.uap2 T.mkNoSrcPos p+                                                    (Hat.Prelude.g_foldr+                                                      T.mkNoSrcPos p)+                                                    (T.ufun2 T.mkLambda+                                                      T.mkNoSrcPos p+                                                      (\ f_x f_y p ->+                                                        T.uccase T.mkNoSrcPos p+                                                          (let+                                                            v0v0v0v0v1 fi4 p =+                                                              T.uap1+                                                                T.mkNoSrcPos p+                                                                (T.uap2+                                                                  T.mkNoSrcPos p+                                                                  (Hat.Prelude.g_foldr+                                                                    T.mkNoSrcPos+                                                                    p)+                                                                  (T.ufun2+                                                                    T.mkLambda+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (\ f_x f_y+                                                                      p ->+                                                                      T.uccase+                                                                        T.mkNoSrcPos+                                                                        p+                                                                        (let+                                                                          v0v0v0v0v1+                                                                            fi5+                                                                            p =+                                                                            T.uap1+                                                                              T.mkNoSrcPos+                                                                              p+                                                                              (T.pa1+                                                                                T.Cons+                                                                                T.cn1+                                                                                T.mkNoSrcPos+                                                                                p+                                                                                T.aCons+                                                                                (T.con5+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  T.Tuple5+                                                                                  T.aTuple5+                                                                                  fi1+                                                                                  fi2+                                                                                  fi3+                                                                                  fi4+                                                                                  fi5))+                                                                              f_y+                                                                          v0v0v0v0v1+                                                                            _+                                                                            p =+                                                                            T.projection+                                                                              T.mkNoSrcPos+                                                                              p+                                                                              f_y+                                                                          in+                                                                          (v0v0v0v0v1))+                                                                        f_x))+                                                                  (T.uap1+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (grange+                                                                      T.mkNoSrcPos+                                                                      p)+                                                                    (T.con2+                                                                      T.mkNoSrcPos+                                                                      p T.Tuple2+                                                                      T.aTuple2+                                                                      fl5 fu5)))+                                                                f_y+                                                            v0v0v0v0v1 _ p =+                                                              T.projection+                                                                T.mkNoSrcPos p+                                                                f_y in+                                                            (v0v0v0v0v1)) f_x))+                                                    (T.uap1 T.mkNoSrcPos p+                                                      (grange T.mkNoSrcPos p)+                                                      (T.con2 T.mkNoSrcPos p+                                                        T.Tuple2 T.aTuple2 fl4+                                                        fu4))) f_y+                                              v0v0v0v0v1 _ p =+                                                T.projection T.mkNoSrcPos p f_y+                                              in (v0v0v0v0v1)) f_x))+                                      (T.uap1 T.mkNoSrcPos p+                                        (grange T.mkNoSrcPos p)+                                        (T.con2 T.mkNoSrcPos p T.Tuple2+                                          T.aTuple2 fl3 fu3))) f_y+                                v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y+                                in (v0v0v0v0v1)) f_x))+                        (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2)))+                      f_y+                  v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in+                  (v0v0v0v0v1)) f_x))+          (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1)))+        (T.fromExpList T.mkNoSrcPos p [])+    hrange _ p = T.fatal p+    +  +  gindex pindex p =+    T.ufun2 a113v5v118v28index pindex p hindex+    where+    +    hindex+      (T.R+        (T.Tuple2 (T.R (T.Tuple5 fl1 fl2 fl3 fl4 fl5) _)+          (T.R (T.Tuple5 fu1 fu2 fu3 fu4 fu5) _)) _)+      (T.R (T.Tuple5 fi1 fi2 fi3 fi4 fi5) _) p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+        (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl5 fu5) fi5)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+          (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl5 fu5))+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+            (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4 fu4) fi4)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+              (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4 fu4))+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                  (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3 fu3) fi3)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                  (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3 fu3))+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                    (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2) fi2)+                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                      (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                        (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2))+                      (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                        (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1)+                        fi1))))))))+    hindex _ _ p = T.fatal p+    +  +  ginRange pinRange p =+    T.ufun2 a120v5v125v32inRange pinRange p hinRange+    where+    +    hinRange+      (T.R+        (T.Tuple2 (T.R (T.Tuple5 fl1 fl2 fl3 fl4 fl5) _)+          (T.R (T.Tuple5 fu1 fu2 fu3 fu4 fu5) _)) _)+      (T.R (T.Tuple5 fi1 fi2 fi3 fi4 fi5) _) p =+      T.uwrapForward p+        (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1) fi1)+            *&&+            (T.uwrapForward p+              (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2) fi2)+                  *&&+                  (T.uwrapForward p+                    (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3 fu3)+                          fi3)+                        *&&+                        (T.uwrapForward p+                          (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4+                                  fu4) fi4)+                              *&&+                              (T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl5+                                  fu5) fi5)) p))) p))) p))) p)+    hinRange _ _ p = T.fatal p+    +  ++instance+  (Ix a1,Ix a2,Ix a3,Ix a4,Ix a5,Ix a6) => Ix ((T.Tuple6 a1 a2 a3 a4 a5 a6))+  where+  +  grange prange p =+    T.ufun1 a129v5v129v9range prange p hrange+    where+    +    hrange+      (T.R+        (T.Tuple2 (T.R (T.Tuple6 fl1 fl2 fl3 fl4 fl5 fl6) _)+          (T.R (T.Tuple6 fu1 fu2 fu3 fu4 fu5 fu6) _)) _) p =+      T.uap1 T.mkNoSrcPos p+        (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+          (T.ufun2 T.mkLambda T.mkNoSrcPos p+            (\ f_x f_y p ->+              T.uccase T.mkNoSrcPos p+                (let+                  v0v0v0v0v1 fi1 p =+                    T.uap1 T.mkNoSrcPos p+                      (T.uap2 T.mkNoSrcPos p+                        (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                        (T.ufun2 T.mkLambda T.mkNoSrcPos p+                          (\ f_x f_y p ->+                            T.uccase T.mkNoSrcPos p+                              (let+                                v0v0v0v0v1 fi2 p =+                                  T.uap1 T.mkNoSrcPos p+                                    (T.uap2 T.mkNoSrcPos p+                                      (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                                      (T.ufun2 T.mkLambda T.mkNoSrcPos p+                                        (\ f_x f_y p ->+                                          T.uccase T.mkNoSrcPos p+                                            (let+                                              v0v0v0v0v1 fi3 p =+                                                T.uap1 T.mkNoSrcPos p+                                                  (T.uap2 T.mkNoSrcPos p+                                                    (Hat.Prelude.g_foldr+                                                      T.mkNoSrcPos p)+                                                    (T.ufun2 T.mkLambda+                                                      T.mkNoSrcPos p+                                                      (\ f_x f_y p ->+                                                        T.uccase T.mkNoSrcPos p+                                                          (let+                                                            v0v0v0v0v1 fi4 p =+                                                              T.uap1+                                                                T.mkNoSrcPos p+                                                                (T.uap2+                                                                  T.mkNoSrcPos p+                                                                  (Hat.Prelude.g_foldr+                                                                    T.mkNoSrcPos+                                                                    p)+                                                                  (T.ufun2+                                                                    T.mkLambda+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (\ f_x f_y+                                                                      p ->+                                                                      T.uccase+                                                                        T.mkNoSrcPos+                                                                        p+                                                                        (let+                                                                          v0v0v0v0v1+                                                                            fi5+                                                                            p =+                                                                            T.uap1+                                                                              T.mkNoSrcPos+                                                                              p+                                                                              (T.uap2+                                                                                T.mkNoSrcPos+                                                                                p+                                                                                (Hat.Prelude.g_foldr+                                                                                  T.mkNoSrcPos+                                                                                  p)+                                                                                (T.ufun2+                                                                                  T.mkLambda+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  (\ f_x+                                                                                    f_y+                                                                                    p ->+                                                                                    T.uccase+                                                                                      T.mkNoSrcPos+                                                                                      p+                                                                                      (let+                                                                                        v0v0v0v0v1+                                                                                          fi6+                                                                                          p =+                                                                                          T.uap1+                                                                                            T.mkNoSrcPos+                                                                                            p+                                                                                            (T.pa1+                                                                                              T.Cons+                                                                                              T.cn1+                                                                                              T.mkNoSrcPos+                                                                                              p+                                                                                              T.aCons+                                                                                              (T.con6+                                                                                                T.mkNoSrcPos+                                                                                                p+                                                                                                T.Tuple6+                                                                                                T.aTuple6+                                                                                                fi1+                                                                                                fi2+                                                                                                fi3+                                                                                                fi4+                                                                                                fi5+                                                                                                fi6))+                                                                                            f_y+                                                                                        v0v0v0v0v1+                                                                                          _+                                                                                          p =+                                                                                          T.projection+                                                                                            T.mkNoSrcPos+                                                                                            p+                                                                                            f_y+                                                                                        in+                                                                                        (v0v0v0v0v1))+                                                                                      f_x))+                                                                                (T.uap1+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  (grange+                                                                                    T.mkNoSrcPos+                                                                                    p)+                                                                                  (T.con2+                                                                                    T.mkNoSrcPos+                                                                                    p+                                                                                    T.Tuple2+                                                                                    T.aTuple2+                                                                                    fl6+                                                                                    fu6)))+                                                                              f_y+                                                                          v0v0v0v0v1+                                                                            _+                                                                            p =+                                                                            T.projection+                                                                              T.mkNoSrcPos+                                                                              p+                                                                              f_y+                                                                          in+                                                                          (v0v0v0v0v1))+                                                                        f_x))+                                                                  (T.uap1+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (grange+                                                                      T.mkNoSrcPos+                                                                      p)+                                                                    (T.con2+                                                                      T.mkNoSrcPos+                                                                      p T.Tuple2+                                                                      T.aTuple2+                                                                      fl5 fu5)))+                                                                f_y+                                                            v0v0v0v0v1 _ p =+                                                              T.projection+                                                                T.mkNoSrcPos p+                                                                f_y in+                                                            (v0v0v0v0v1)) f_x))+                                                    (T.uap1 T.mkNoSrcPos p+                                                      (grange T.mkNoSrcPos p)+                                                      (T.con2 T.mkNoSrcPos p+                                                        T.Tuple2 T.aTuple2 fl4+                                                        fu4))) f_y+                                              v0v0v0v0v1 _ p =+                                                T.projection T.mkNoSrcPos p f_y+                                              in (v0v0v0v0v1)) f_x))+                                      (T.uap1 T.mkNoSrcPos p+                                        (grange T.mkNoSrcPos p)+                                        (T.con2 T.mkNoSrcPos p T.Tuple2+                                          T.aTuple2 fl3 fu3))) f_y+                                v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y+                                in (v0v0v0v0v1)) f_x))+                        (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2)))+                      f_y+                  v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in+                  (v0v0v0v0v1)) f_x))+          (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1)))+        (T.fromExpList T.mkNoSrcPos p [])+    hrange _ p = T.fatal p+    +  +  gindex pindex p =+    T.ufun2 a137v5v143v29index pindex p hindex+    where+    +    hindex+      (T.R+        (T.Tuple2 (T.R (T.Tuple6 fl1 fl2 fl3 fl4 fl5 fl6) _)+          (T.R (T.Tuple6 fu1 fu2 fu3 fu4 fu5 fu6) _)) _)+      (T.R (T.Tuple6 fi1 fi2 fi3 fi4 fi5 fi6) _) p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+        (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl6 fu6) fi6)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+          (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl6 fu6))+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+            (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl5 fu5) fi5)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+              (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl5 fu5))+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                  (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4 fu4) fi4)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                  (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4 fu4))+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                    (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3 fu3) fi3)+                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                      (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                        (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3 fu3))+                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                        (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2)+                          fi2)+                        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                          (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2))+                          (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1)+                            fi1))))))))))+    hindex _ _ p = T.fatal p+    +  +  ginRange pinRange p =+    T.ufun2 a145v5v151v32inRange pinRange p hinRange+    where+    +    hinRange+      (T.R+        (T.Tuple2 (T.R (T.Tuple6 fl1 fl2 fl3 fl4 fl5 fl6) _)+          (T.R (T.Tuple6 fu1 fu2 fu3 fu4 fu5 fu6) _)) _)+      (T.R (T.Tuple6 fi1 fi2 fi3 fi4 fi5 fi6) _) p =+      T.uwrapForward p+        (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1) fi1)+            *&&+            (T.uwrapForward p+              (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2) fi2)+                  *&&+                  (T.uwrapForward p+                    (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3 fu3)+                          fi3)+                        *&&+                        (T.uwrapForward p+                          (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4+                                  fu4) fi4)+                              *&&+                              (T.uwrapForward p+                                (((T.uap2 T.mkNoSrcPos p+                                      (ginRange T.mkNoSrcPos p)+                                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                        fl5 fu5) fi5)+                                    *&&+                                    (T.uap2 T.mkNoSrcPos p+                                      (ginRange T.mkNoSrcPos p)+                                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                        fl6 fu6) fi6)) p))) p))) p))) p))) p)+    hinRange _ _ p = T.fatal p+    +  ++instance+  (Ix a1,Ix a2,Ix a3,Ix a4,Ix a5,Ix a6,Ix a7) =>+    Ix ((T.Tuple7 a1 a2 a3 a4 a5 a6 a7))+  where+  +  grange prange p =+    T.ufun1 a155v5v155v9range prange p hrange+    where+    +    hrange+      (T.R+        (T.Tuple2 (T.R (T.Tuple7 fl1 fl2 fl3 fl4 fl5 fl6 fl7) _)+          (T.R (T.Tuple7 fu1 fu2 fu3 fu4 fu5 fu6 fu7) _)) _) p =+      T.uap1 T.mkNoSrcPos p+        (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+          (T.ufun2 T.mkLambda T.mkNoSrcPos p+            (\ f_x f_y p ->+              T.uccase T.mkNoSrcPos p+                (let+                  v0v0v0v0v1 fi1 p =+                    T.uap1 T.mkNoSrcPos p+                      (T.uap2 T.mkNoSrcPos p+                        (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                        (T.ufun2 T.mkLambda T.mkNoSrcPos p+                          (\ f_x f_y p ->+                            T.uccase T.mkNoSrcPos p+                              (let+                                v0v0v0v0v1 fi2 p =+                                  T.uap1 T.mkNoSrcPos p+                                    (T.uap2 T.mkNoSrcPos p+                                      (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                                      (T.ufun2 T.mkLambda T.mkNoSrcPos p+                                        (\ f_x f_y p ->+                                          T.uccase T.mkNoSrcPos p+                                            (let+                                              v0v0v0v0v1 fi3 p =+                                                T.uap1 T.mkNoSrcPos p+                                                  (T.uap2 T.mkNoSrcPos p+                                                    (Hat.Prelude.g_foldr+                                                      T.mkNoSrcPos p)+                                                    (T.ufun2 T.mkLambda+                                                      T.mkNoSrcPos p+                                                      (\ f_x f_y p ->+                                                        T.uccase T.mkNoSrcPos p+                                                          (let+                                                            v0v0v0v0v1 fi4 p =+                                                              T.uap1+                                                                T.mkNoSrcPos p+                                                                (T.uap2+                                                                  T.mkNoSrcPos p+                                                                  (Hat.Prelude.g_foldr+                                                                    T.mkNoSrcPos+                                                                    p)+                                                                  (T.ufun2+                                                                    T.mkLambda+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (\ f_x f_y+                                                                      p ->+                                                                      T.uccase+                                                                        T.mkNoSrcPos+                                                                        p+                                                                        (let+                                                                          v0v0v0v0v1+                                                                            fi5+                                                                            p =+                                                                            T.uap1+                                                                              T.mkNoSrcPos+                                                                              p+                                                                              (T.uap2+                                                                                T.mkNoSrcPos+                                                                                p+                                                                                (Hat.Prelude.g_foldr+                                                                                  T.mkNoSrcPos+                                                                                  p)+                                                                                (T.ufun2+                                                                                  T.mkLambda+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  (\ f_x+                                                                                    f_y+                                                                                    p ->+                                                                                    T.uccase+                                                                                      T.mkNoSrcPos+                                                                                      p+                                                                                      (let+                                                                                        v0v0v0v0v1+                                                                                          fi6+                                                                                          p =+                                                                                          T.uap1+                                                                                            T.mkNoSrcPos+                                                                                            p+                                                                                            (T.uap2+                                                                                              T.mkNoSrcPos+                                                                                              p+                                                                                              (Hat.Prelude.g_foldr+                                                                                                T.mkNoSrcPos+                                                                                                p)+                                                                                              (T.ufun2+                                                                                                T.mkLambda+                                                                                                T.mkNoSrcPos+                                                                                                p+                                                                                                (\ f_x+                                                                                                  f_y+                                                                                                  p ->+                                                                                                  T.uccase+                                                                                                    T.mkNoSrcPos+                                                                                                    p+                                                                                                    (let+                                                                                                      v0v0v0v0v1+                                                                                                        fi7+                                                                                                        p =+                                                                                                        T.uap1+                                                                                                          T.mkNoSrcPos+                                                                                                          p+                                                                                                          (T.pa1+                                                                                                            T.Cons+                                                                                                            T.cn1+                                                                                                            T.mkNoSrcPos+                                                                                                            p+                                                                                                            T.aCons+                                                                                                            (T.con7+                                                                                                              T.mkNoSrcPos+                                                                                                              p+                                                                                                              T.Tuple7+                                                                                                              T.aTuple7+                                                                                                              fi1+                                                                                                              fi2+                                                                                                              fi3+                                                                                                              fi4+                                                                                                              fi5+                                                                                                              fi6+                                                                                                              fi7))+                                                                                                          f_y+                                                                                                      v0v0v0v0v1+                                                                                                        _+                                                                                                        p =+                                                                                                        T.projection+                                                                                                          T.mkNoSrcPos+                                                                                                          p+                                                                                                          f_y+                                                                                                      in+                                                                                                      (v0v0v0v0v1))+                                                                                                    f_x))+                                                                                              (T.uap1+                                                                                                T.mkNoSrcPos+                                                                                                p+                                                                                                (grange+                                                                                                  T.mkNoSrcPos+                                                                                                  p)+                                                                                                (T.con2+                                                                                                  T.mkNoSrcPos+                                                                                                  p+                                                                                                  T.Tuple2+                                                                                                  T.aTuple2+                                                                                                  fl7+                                                                                                  fu7)))+                                                                                            f_y+                                                                                        v0v0v0v0v1+                                                                                          _+                                                                                          p =+                                                                                          T.projection+                                                                                            T.mkNoSrcPos+                                                                                            p+                                                                                            f_y+                                                                                        in+                                                                                        (v0v0v0v0v1))+                                                                                      f_x))+                                                                                (T.uap1+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  (grange+                                                                                    T.mkNoSrcPos+                                                                                    p)+                                                                                  (T.con2+                                                                                    T.mkNoSrcPos+                                                                                    p+                                                                                    T.Tuple2+                                                                                    T.aTuple2+                                                                                    fl6+                                                                                    fu6)))+                                                                              f_y+                                                                          v0v0v0v0v1+                                                                            _+                                                                            p =+                                                                            T.projection+                                                                              T.mkNoSrcPos+                                                                              p+                                                                              f_y+                                                                          in+                                                                          (v0v0v0v0v1))+                                                                        f_x))+                                                                  (T.uap1+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (grange+                                                                      T.mkNoSrcPos+                                                                      p)+                                                                    (T.con2+                                                                      T.mkNoSrcPos+                                                                      p T.Tuple2+                                                                      T.aTuple2+                                                                      fl5 fu5)))+                                                                f_y+                                                            v0v0v0v0v1 _ p =+                                                              T.projection+                                                                T.mkNoSrcPos p+                                                                f_y in+                                                            (v0v0v0v0v1)) f_x))+                                                    (T.uap1 T.mkNoSrcPos p+                                                      (grange T.mkNoSrcPos p)+                                                      (T.con2 T.mkNoSrcPos p+                                                        T.Tuple2 T.aTuple2 fl4+                                                        fu4))) f_y+                                              v0v0v0v0v1 _ p =+                                                T.projection T.mkNoSrcPos p f_y+                                              in (v0v0v0v0v1)) f_x))+                                      (T.uap1 T.mkNoSrcPos p+                                        (grange T.mkNoSrcPos p)+                                        (T.con2 T.mkNoSrcPos p T.Tuple2+                                          T.aTuple2 fl3 fu3))) f_y+                                v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y+                                in (v0v0v0v0v1)) f_x))+                        (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2)))+                      f_y+                  v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in+                  (v0v0v0v0v1)) f_x))+          (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1)))+        (T.fromExpList T.mkNoSrcPos p [])+    hrange _ p = T.fatal p+    +  +  gindex pindex p =+    T.ufun2 a164v5v171v29index pindex p hindex+    where+    +    hindex+      (T.R+        (T.Tuple2 (T.R (T.Tuple7 fl1 fl2 fl3 fl4 fl5 fl6 fl7) _)+          (T.R (T.Tuple7 fu1 fu2 fu3 fu4 fu5 fu6 fu7) _)) _)+      (T.R (T.Tuple7 fi1 fi2 fi3 fi4 fi5 fi6 fi7) _) p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+        (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl7 fu7) fi7)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+          (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl7 fu7))+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+            (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl6 fu6) fi6)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+              (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl6 fu6))+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                  (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl5 fu5) fi5)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                  (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl5 fu5))+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                    (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4 fu4) fi4)+                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                      (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                        (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4 fu4))+                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                        (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3 fu3)+                          fi3)+                        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                          (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3 fu3))+                          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                            (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2)+                              fi2)+                            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                              (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2+                                  fu2))+                              (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1+                                  fu1) fi1))))))))))))+    hindex _ _ p = T.fatal p+    +  +  ginRange pinRange p =+    T.ufun2 a173v5v180v32inRange pinRange p hinRange+    where+    +    hinRange+      (T.R+        (T.Tuple2 (T.R (T.Tuple7 fl1 fl2 fl3 fl4 fl5 fl6 fl7) _)+          (T.R (T.Tuple7 fu1 fu2 fu3 fu4 fu5 fu6 fu7) _)) _)+      (T.R (T.Tuple7 fi1 fi2 fi3 fi4 fi5 fi6 fi7) _) p =+      T.uwrapForward p+        (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1) fi1)+            *&&+            (T.uwrapForward p+              (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2) fi2)+                  *&&+                  (T.uwrapForward p+                    (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3 fu3)+                          fi3)+                        *&&+                        (T.uwrapForward p+                          (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4+                                  fu4) fi4)+                              *&&+                              (T.uwrapForward p+                                (((T.uap2 T.mkNoSrcPos p+                                      (ginRange T.mkNoSrcPos p)+                                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                        fl5 fu5) fi5)+                                    *&&+                                    (T.uwrapForward p+                                      (((T.uap2 T.mkNoSrcPos p+                                            (ginRange T.mkNoSrcPos p)+                                            (T.con2 T.mkNoSrcPos p T.Tuple2+                                              T.aTuple2 fl6 fu6) fi6)+                                          *&&+                                          (T.uap2 T.mkNoSrcPos p+                                            (ginRange T.mkNoSrcPos p)+                                            (T.con2 T.mkNoSrcPos p T.Tuple2+                                              T.aTuple2 fl7 fu7) fi7)) p))) p)))+                            p))) p))) p))) p)+    hinRange _ _ p = T.fatal p+    +  ++instance+  (Ix a1,Ix a2,Ix a3,Ix a4,Ix a5,Ix a6,Ix a7,Ix a8) =>+    Ix ((T.Tuple8 a1 a2 a3 a4 a5 a6 a7 a8))+  where+  +  grange prange p =+    T.ufun1 a184v5v184v9range prange p hrange+    where+    +    hrange+      (T.R+        (T.Tuple2 (T.R (T.Tuple8 fl1 fl2 fl3 fl4 fl5 fl6 fl7 fl8) _)+          (T.R (T.Tuple8 fu1 fu2 fu3 fu4 fu5 fu6 fu7 fu8) _)) _) p =+      T.uap1 T.mkNoSrcPos p+        (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+          (T.ufun2 T.mkLambda T.mkNoSrcPos p+            (\ f_x f_y p ->+              T.uccase T.mkNoSrcPos p+                (let+                  v0v0v0v0v1 fi1 p =+                    T.uap1 T.mkNoSrcPos p+                      (T.uap2 T.mkNoSrcPos p+                        (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                        (T.ufun2 T.mkLambda T.mkNoSrcPos p+                          (\ f_x f_y p ->+                            T.uccase T.mkNoSrcPos p+                              (let+                                v0v0v0v0v1 fi2 p =+                                  T.uap1 T.mkNoSrcPos p+                                    (T.uap2 T.mkNoSrcPos p+                                      (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                                      (T.ufun2 T.mkLambda T.mkNoSrcPos p+                                        (\ f_x f_y p ->+                                          T.uccase T.mkNoSrcPos p+                                            (let+                                              v0v0v0v0v1 fi3 p =+                                                T.uap1 T.mkNoSrcPos p+                                                  (T.uap2 T.mkNoSrcPos p+                                                    (Hat.Prelude.g_foldr+                                                      T.mkNoSrcPos p)+                                                    (T.ufun2 T.mkLambda+                                                      T.mkNoSrcPos p+                                                      (\ f_x f_y p ->+                                                        T.uccase T.mkNoSrcPos p+                                                          (let+                                                            v0v0v0v0v1 fi4 p =+                                                              T.uap1+                                                                T.mkNoSrcPos p+                                                                (T.uap2+                                                                  T.mkNoSrcPos p+                                                                  (Hat.Prelude.g_foldr+                                                                    T.mkNoSrcPos+                                                                    p)+                                                                  (T.ufun2+                                                                    T.mkLambda+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (\ f_x f_y+                                                                      p ->+                                                                      T.uccase+                                                                        T.mkNoSrcPos+                                                                        p+                                                                        (let+                                                                          v0v0v0v0v1+                                                                            fi5+                                                                            p =+                                                                            T.uap1+                                                                              T.mkNoSrcPos+                                                                              p+                                                                              (T.uap2+                                                                                T.mkNoSrcPos+                                                                                p+                                                                                (Hat.Prelude.g_foldr+                                                                                  T.mkNoSrcPos+                                                                                  p)+                                                                                (T.ufun2+                                                                                  T.mkLambda+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  (\ f_x+                                                                                    f_y+                                                                                    p ->+                                                                                    T.uccase+                                                                                      T.mkNoSrcPos+                                                                                      p+                                                                                      (let+                                                                                        v0v0v0v0v1+                                                                                          fi6+                                                                                          p =+                                                                                          T.uap1+                                                                                            T.mkNoSrcPos+                                                                                            p+                                                                                            (T.uap2+                                                                                              T.mkNoSrcPos+                                                                                              p+                                                                                              (Hat.Prelude.g_foldr+                                                                                                T.mkNoSrcPos+                                                                                                p)+                                                                                              (T.ufun2+                                                                                                T.mkLambda+                                                                                                T.mkNoSrcPos+                                                                                                p+                                                                                                (\ f_x+                                                                                                  f_y+                                                                                                  p ->+                                                                                                  T.uccase+                                                                                                    T.mkNoSrcPos+                                                                                                    p+                                                                                                    (let+                                                                                                      v0v0v0v0v1+                                                                                                        fi7+                                                                                                        p =+                                                                                                        T.uap1+                                                                                                          T.mkNoSrcPos+                                                                                                          p+                                                                                                          (T.uap2+                                                                                                            T.mkNoSrcPos+                                                                                                            p+                                                                                                            (Hat.Prelude.g_foldr+                                                                                                              T.mkNoSrcPos+                                                                                                              p)+                                                                                                            (T.ufun2+                                                                                                              T.mkLambda+                                                                                                              T.mkNoSrcPos+                                                                                                              p+                                                                                                              (\ f_x+                                                                                                                f_y+                                                                                                                p ->+                                                                                                                T.uccase+                                                                                                                  T.mkNoSrcPos+                                                                                                                  p+                                                                                                                  (let+                                                                                                                    v0v0v0v0v1+                                                                                                                      fi8+                                                                                                                      p =+                                                                                                                      T.uap1+                                                                                                                        T.mkNoSrcPos+                                                                                                                        p+                                                                                                                        (T.pa1+                                                                                                                          T.Cons+                                                                                                                          T.cn1+                                                                                                                          T.mkNoSrcPos+                                                                                                                          p+                                                                                                                          T.aCons+                                                                                                                          (T.con8+                                                                                                                            T.mkNoSrcPos+                                                                                                                            p+                                                                                                                            T.Tuple8+                                                                                                                            T.aTuple8+                                                                                                                            fi1+                                                                                                                            fi2+                                                                                                                            fi3+                                                                                                                            fi4+                                                                                                                            fi5+                                                                                                                            fi6+                                                                                                                            fi7+                                                                                                                            fi8))+                                                                                                                        f_y+                                                                                                                    v0v0v0v0v1+                                                                                                                      _+                                                                                                                      p =+                                                                                                                      T.projection+                                                                                                                        T.mkNoSrcPos+                                                                                                                        p+                                                                                                                        f_y+                                                                                                                    in+                                                                                                                    (v0v0v0v0v1))+                                                                                                                  f_x))+                                                                                                            (T.uap1+                                                                                                              T.mkNoSrcPos+                                                                                                              p+                                                                                                              (grange+                                                                                                                T.mkNoSrcPos+                                                                                                                p)+                                                                                                              (T.con2+                                                                                                                T.mkNoSrcPos+                                                                                                                p+                                                                                                                T.Tuple2+                                                                                                                T.aTuple2+                                                                                                                fl8+                                                                                                                fu8)))+                                                                                                          f_y+                                                                                                      v0v0v0v0v1+                                                                                                        _+                                                                                                        p =+                                                                                                        T.projection+                                                                                                          T.mkNoSrcPos+                                                                                                          p+                                                                                                          f_y+                                                                                                      in+                                                                                                      (v0v0v0v0v1))+                                                                                                    f_x))+                                                                                              (T.uap1+                                                                                                T.mkNoSrcPos+                                                                                                p+                                                                                                (grange+                                                                                                  T.mkNoSrcPos+                                                                                                  p)+                                                                                                (T.con2+                                                                                                  T.mkNoSrcPos+                                                                                                  p+                                                                                                  T.Tuple2+                                                                                                  T.aTuple2+                                                                                                  fl7+                                                                                                  fu7)))+                                                                                            f_y+                                                                                        v0v0v0v0v1+                                                                                          _+                                                                                          p =+                                                                                          T.projection+                                                                                            T.mkNoSrcPos+                                                                                            p+                                                                                            f_y+                                                                                        in+                                                                                        (v0v0v0v0v1))+                                                                                      f_x))+                                                                                (T.uap1+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  (grange+                                                                                    T.mkNoSrcPos+                                                                                    p)+                                                                                  (T.con2+                                                                                    T.mkNoSrcPos+                                                                                    p+                                                                                    T.Tuple2+                                                                                    T.aTuple2+                                                                                    fl6+                                                                                    fu6)))+                                                                              f_y+                                                                          v0v0v0v0v1+                                                                            _+                                                                            p =+                                                                            T.projection+                                                                              T.mkNoSrcPos+                                                                              p+                                                                              f_y+                                                                          in+                                                                          (v0v0v0v0v1))+                                                                        f_x))+                                                                  (T.uap1+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (grange+                                                                      T.mkNoSrcPos+                                                                      p)+                                                                    (T.con2+                                                                      T.mkNoSrcPos+                                                                      p T.Tuple2+                                                                      T.aTuple2+                                                                      fl5 fu5)))+                                                                f_y+                                                            v0v0v0v0v1 _ p =+                                                              T.projection+                                                                T.mkNoSrcPos p+                                                                f_y in+                                                            (v0v0v0v0v1)) f_x))+                                                    (T.uap1 T.mkNoSrcPos p+                                                      (grange T.mkNoSrcPos p)+                                                      (T.con2 T.mkNoSrcPos p+                                                        T.Tuple2 T.aTuple2 fl4+                                                        fu4))) f_y+                                              v0v0v0v0v1 _ p =+                                                T.projection T.mkNoSrcPos p f_y+                                              in (v0v0v0v0v1)) f_x))+                                      (T.uap1 T.mkNoSrcPos p+                                        (grange T.mkNoSrcPos p)+                                        (T.con2 T.mkNoSrcPos p T.Tuple2+                                          T.aTuple2 fl3 fu3))) f_y+                                v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y+                                in (v0v0v0v0v1)) f_x))+                        (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2)))+                      f_y+                  v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in+                  (v0v0v0v0v1)) f_x))+          (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1)))+        (T.fromExpList T.mkNoSrcPos p [])+    hrange _ p = T.fatal p+    +  +  gindex pindex p =+    T.ufun2 a194v5v203v30index pindex p hindex+    where+    +    hindex+      (T.R+        (T.Tuple2 (T.R (T.Tuple8 fl1 fl2 fl3 fl4 fl5 fl6 fl7 fl8) _)+          (T.R (T.Tuple8 fu1 fu2 fu3 fu4 fu5 fu6 fu7 fu8) _)) _)+      (T.R (T.Tuple8 fi1 fi2 fi3 fi4 fi5 fi6 fi7 fi8) _) p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+        (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl8 fu8) fi8)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+          (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl8 fu8))+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+            (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl7 fu7) fi7)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+              (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl7 fu7))+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                  (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl6 fu6) fi6)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                  (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl6 fu6))+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                    (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl5 fu5) fi5)+                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                      (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                        (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl5 fu5))+                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                        (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4 fu4)+                          fi4)+                        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                          (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4 fu4))+                          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                            (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3 fu3)+                              fi3)+                            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                              (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3+                                  fu3))+                              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                                (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                                  (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2+                                    fu2) fi2)+                                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                                  (T.uap1 T.mkNoSrcPos p+                                    (grangeSize T.mkNoSrcPos p)+                                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                      fl2 fu2))+                                  (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                      fl1 fu1) fi1))))))))))))))+    hindex _ _ p = T.fatal p+    +  +  ginRange pinRange p =+    T.ufun2 a205v5v214v32inRange pinRange p hinRange+    where+    +    hinRange+      (T.R+        (T.Tuple2 (T.R (T.Tuple8 fl1 fl2 fl3 fl4 fl5 fl6 fl7 fl8) _)+          (T.R (T.Tuple8 fu1 fu2 fu3 fu4 fu5 fu6 fu7 fu8) _)) _)+      (T.R (T.Tuple8 fi1 fi2 fi3 fi4 fi5 fi6 fi7 fi8) _) p =+      T.uwrapForward p+        (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1) fi1)+            *&&+            (T.uwrapForward p+              (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2) fi2)+                  *&&+                  (T.uwrapForward p+                    (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3 fu3)+                          fi3)+                        *&&+                        (T.uwrapForward p+                          (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4+                                  fu4) fi4)+                              *&&+                              (T.uwrapForward p+                                (((T.uap2 T.mkNoSrcPos p+                                      (ginRange T.mkNoSrcPos p)+                                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                        fl5 fu5) fi5)+                                    *&&+                                    (T.uwrapForward p+                                      (((T.uap2 T.mkNoSrcPos p+                                            (ginRange T.mkNoSrcPos p)+                                            (T.con2 T.mkNoSrcPos p T.Tuple2+                                              T.aTuple2 fl6 fu6) fi6)+                                          *&&+                                          (T.uwrapForward p+                                            (((T.uap2 T.mkNoSrcPos p+                                                  (ginRange T.mkNoSrcPos p)+                                                  (T.con2 T.mkNoSrcPos p+                                                    T.Tuple2 T.aTuple2 fl7 fu7)+                                                  fi7)+                                                *&&+                                                (T.uap2 T.mkNoSrcPos p+                                                  (ginRange T.mkNoSrcPos p)+                                                  (T.con2 T.mkNoSrcPos p+                                                    T.Tuple2 T.aTuple2 fl8 fu8)+                                                  fi8)) p))) p))) p))) p))) p)))+                p))) p)+    hinRange _ _ p = T.fatal p+    +  ++instance+  (Ix a1,Ix a2,Ix a3,Ix a4,Ix a5,Ix a6,Ix a7,Ix a8,Ix a9) =>+    Ix ((T.Tuple9 a1 a2 a3 a4 a5 a6 a7 a8 a9))+  where+  +  grange prange p =+    T.ufun1 a218v5v218v9range prange p hrange+    where+    +    hrange+      (T.R+        (T.Tuple2 (T.R (T.Tuple9 fl1 fl2 fl3 fl4 fl5 fl6 fl7 fl8 fl9) _)+          (T.R (T.Tuple9 fu1 fu2 fu3 fu4 fu5 fu6 fu7 fu8 fu9) _)) _) p =+      T.uap1 T.mkNoSrcPos p+        (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+          (T.ufun2 T.mkLambda T.mkNoSrcPos p+            (\ f_x f_y p ->+              T.uccase T.mkNoSrcPos p+                (let+                  v0v0v0v0v1 fi1 p =+                    T.uap1 T.mkNoSrcPos p+                      (T.uap2 T.mkNoSrcPos p+                        (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                        (T.ufun2 T.mkLambda T.mkNoSrcPos p+                          (\ f_x f_y p ->+                            T.uccase T.mkNoSrcPos p+                              (let+                                v0v0v0v0v1 fi2 p =+                                  T.uap1 T.mkNoSrcPos p+                                    (T.uap2 T.mkNoSrcPos p+                                      (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                                      (T.ufun2 T.mkLambda T.mkNoSrcPos p+                                        (\ f_x f_y p ->+                                          T.uccase T.mkNoSrcPos p+                                            (let+                                              v0v0v0v0v1 fi3 p =+                                                T.uap1 T.mkNoSrcPos p+                                                  (T.uap2 T.mkNoSrcPos p+                                                    (Hat.Prelude.g_foldr+                                                      T.mkNoSrcPos p)+                                                    (T.ufun2 T.mkLambda+                                                      T.mkNoSrcPos p+                                                      (\ f_x f_y p ->+                                                        T.uccase T.mkNoSrcPos p+                                                          (let+                                                            v0v0v0v0v1 fi4 p =+                                                              T.uap1+                                                                T.mkNoSrcPos p+                                                                (T.uap2+                                                                  T.mkNoSrcPos p+                                                                  (Hat.Prelude.g_foldr+                                                                    T.mkNoSrcPos+                                                                    p)+                                                                  (T.ufun2+                                                                    T.mkLambda+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (\ f_x f_y+                                                                      p ->+                                                                      T.uccase+                                                                        T.mkNoSrcPos+                                                                        p+                                                                        (let+                                                                          v0v0v0v0v1+                                                                            fi5+                                                                            p =+                                                                            T.uap1+                                                                              T.mkNoSrcPos+                                                                              p+                                                                              (T.uap2+                                                                                T.mkNoSrcPos+                                                                                p+                                                                                (Hat.Prelude.g_foldr+                                                                                  T.mkNoSrcPos+                                                                                  p)+                                                                                (T.ufun2+                                                                                  T.mkLambda+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  (\ f_x+                                                                                    f_y+                                                                                    p ->+                                                                                    T.uccase+                                                                                      T.mkNoSrcPos+                                                                                      p+                                                                                      (let+                                                                                        v0v0v0v0v1+                                                                                          fi6+                                                                                          p =+                                                                                          T.uap1+                                                                                            T.mkNoSrcPos+                                                                                            p+                                                                                            (T.uap2+                                                                                              T.mkNoSrcPos+                                                                                              p+                                                                                              (Hat.Prelude.g_foldr+                                                                                                T.mkNoSrcPos+                                                                                                p)+                                                                                              (T.ufun2+                                                                                                T.mkLambda+                                                                                                T.mkNoSrcPos+                                                                                                p+                                                                                                (\ f_x+                                                                                                  f_y+                                                                                                  p ->+                                                                                                  T.uccase+                                                                                                    T.mkNoSrcPos+                                                                                                    p+                                                                                                    (let+                                                                                                      v0v0v0v0v1+                                                                                                        fi7+                                                                                                        p =+                                                                                                        T.uap1+                                                                                                          T.mkNoSrcPos+                                                                                                          p+                                                                                                          (T.uap2+                                                                                                            T.mkNoSrcPos+                                                                                                            p+                                                                                                            (Hat.Prelude.g_foldr+                                                                                                              T.mkNoSrcPos+                                                                                                              p)+                                                                                                            (T.ufun2+                                                                                                              T.mkLambda+                                                                                                              T.mkNoSrcPos+                                                                                                              p+                                                                                                              (\ f_x+                                                                                                                f_y+                                                                                                                p ->+                                                                                                                T.uccase+                                                                                                                  T.mkNoSrcPos+                                                                                                                  p+                                                                                                                  (let+                                                                                                                    v0v0v0v0v1+                                                                                                                      fi8+                                                                                                                      p =+                                                                                                                      T.uap1+                                                                                                                        T.mkNoSrcPos+                                                                                                                        p+                                                                                                                        (T.uap2+                                                                                                                          T.mkNoSrcPos+                                                                                                                          p+                                                                                                                          (Hat.Prelude.g_foldr+                                                                                                                            T.mkNoSrcPos+                                                                                                                            p)+                                                                                                                          (T.ufun2+                                                                                                                            T.mkLambda+                                                                                                                            T.mkNoSrcPos+                                                                                                                            p+                                                                                                                            (\ f_x+                                                                                                                              f_y+                                                                                                                              p ->+                                                                                                                              T.uccase+                                                                                                                                T.mkNoSrcPos+                                                                                                                                p+                                                                                                                                (let+                                                                                                                                  v0v0v0v0v1+                                                                                                                                    fi9+                                                                                                                                    p =+                                                                                                                                    T.uap1+                                                                                                                                      T.mkNoSrcPos+                                                                                                                                      p+                                                                                                                                      (T.pa1+                                                                                                                                        T.Cons+                                                                                                                                        T.cn1+                                                                                                                                        T.mkNoSrcPos+                                                                                                                                        p+                                                                                                                                        T.aCons+                                                                                                                                        (T.con9+                                                                                                                                          T.mkNoSrcPos+                                                                                                                                          p+                                                                                                                                          T.Tuple9+                                                                                                                                          T.aTuple9+                                                                                                                                          fi1+                                                                                                                                          fi2+                                                                                                                                          fi3+                                                                                                                                          fi4+                                                                                                                                          fi5+                                                                                                                                          fi6+                                                                                                                                          fi7+                                                                                                                                          fi8+                                                                                                                                          fi9))+                                                                                                                                      f_y+                                                                                                                                  v0v0v0v0v1+                                                                                                                                    _+                                                                                                                                    p =+                                                                                                                                    T.projection+                                                                                                                                      T.mkNoSrcPos+                                                                                                                                      p+                                                                                                                                      f_y+                                                                                                                                  in+                                                                                                                                  (v0v0v0v0v1))+                                                                                                                                f_x))+                                                                                                                          (T.uap1+                                                                                                                            T.mkNoSrcPos+                                                                                                                            p+                                                                                                                            (grange+                                                                                                                              T.mkNoSrcPos+                                                                                                                              p)+                                                                                                                            (T.con2+                                                                                                                              T.mkNoSrcPos+                                                                                                                              p+                                                                                                                              T.Tuple2+                                                                                                                              T.aTuple2+                                                                                                                              fl9+                                                                                                                              fu9)))+                                                                                                                        f_y+                                                                                                                    v0v0v0v0v1+                                                                                                                      _+                                                                                                                      p =+                                                                                                                      T.projection+                                                                                                                        T.mkNoSrcPos+                                                                                                                        p+                                                                                                                        f_y+                                                                                                                    in+                                                                                                                    (v0v0v0v0v1))+                                                                                                                  f_x))+                                                                                                            (T.uap1+                                                                                                              T.mkNoSrcPos+                                                                                                              p+                                                                                                              (grange+                                                                                                                T.mkNoSrcPos+                                                                                                                p)+                                                                                                              (T.con2+                                                                                                                T.mkNoSrcPos+                                                                                                                p+                                                                                                                T.Tuple2+                                                                                                                T.aTuple2+                                                                                                                fl8+                                                                                                                fu8)))+                                                                                                          f_y+                                                                                                      v0v0v0v0v1+                                                                                                        _+                                                                                                        p =+                                                                                                        T.projection+                                                                                                          T.mkNoSrcPos+                                                                                                          p+                                                                                                          f_y+                                                                                                      in+                                                                                                      (v0v0v0v0v1))+                                                                                                    f_x))+                                                                                              (T.uap1+                                                                                                T.mkNoSrcPos+                                                                                                p+                                                                                                (grange+                                                                                                  T.mkNoSrcPos+                                                                                                  p)+                                                                                                (T.con2+                                                                                                  T.mkNoSrcPos+                                                                                                  p+                                                                                                  T.Tuple2+                                                                                                  T.aTuple2+                                                                                                  fl7+                                                                                                  fu7)))+                                                                                            f_y+                                                                                        v0v0v0v0v1+                                                                                          _+                                                                                          p =+                                                                                          T.projection+                                                                                            T.mkNoSrcPos+                                                                                            p+                                                                                            f_y+                                                                                        in+                                                                                        (v0v0v0v0v1))+                                                                                      f_x))+                                                                                (T.uap1+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  (grange+                                                                                    T.mkNoSrcPos+                                                                                    p)+                                                                                  (T.con2+                                                                                    T.mkNoSrcPos+                                                                                    p+                                                                                    T.Tuple2+                                                                                    T.aTuple2+                                                                                    fl6+                                                                                    fu6)))+                                                                              f_y+                                                                          v0v0v0v0v1+                                                                            _+                                                                            p =+                                                                            T.projection+                                                                              T.mkNoSrcPos+                                                                              p+                                                                              f_y+                                                                          in+                                                                          (v0v0v0v0v1))+                                                                        f_x))+                                                                  (T.uap1+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (grange+                                                                      T.mkNoSrcPos+                                                                      p)+                                                                    (T.con2+                                                                      T.mkNoSrcPos+                                                                      p T.Tuple2+                                                                      T.aTuple2+                                                                      fl5 fu5)))+                                                                f_y+                                                            v0v0v0v0v1 _ p =+                                                              T.projection+                                                                T.mkNoSrcPos p+                                                                f_y in+                                                            (v0v0v0v0v1)) f_x))+                                                    (T.uap1 T.mkNoSrcPos p+                                                      (grange T.mkNoSrcPos p)+                                                      (T.con2 T.mkNoSrcPos p+                                                        T.Tuple2 T.aTuple2 fl4+                                                        fu4))) f_y+                                              v0v0v0v0v1 _ p =+                                                T.projection T.mkNoSrcPos p f_y+                                              in (v0v0v0v0v1)) f_x))+                                      (T.uap1 T.mkNoSrcPos p+                                        (grange T.mkNoSrcPos p)+                                        (T.con2 T.mkNoSrcPos p T.Tuple2+                                          T.aTuple2 fl3 fu3))) f_y+                                v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y+                                in (v0v0v0v0v1)) f_x))+                        (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2)))+                      f_y+                  v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in+                  (v0v0v0v0v1)) f_x))+          (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1)))+        (T.fromExpList T.mkNoSrcPos p [])+    hrange _ p = T.fatal p+    +  +  gindex pindex p =+    T.ufun2 a230v5v240v36index pindex p hindex+    where+    +    hindex+      (T.R+        (T.Tuple2 (T.R (T.Tuple9 fl1 fl2 fl3 fl4 fl5 fl6 fl7 fl8 fl9) _)+          (T.R (T.Tuple9 fu1 fu2 fu3 fu4 fu5 fu6 fu7 fu8 fu9) _)) _)+      (T.R (T.Tuple9 fi1 fi2 fi3 fi4 fi5 fi6 fi7 fi8 fi9) _) p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+        (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl9 fu9) fi9)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+          (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl9 fu9))+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+            (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl8 fu8) fi8)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+              (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl8 fu8))+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                  (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl7 fu7) fi7)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                  (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl7 fu7))+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                    (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl6 fu6) fi6)+                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                      (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                        (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl6 fu6))+                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                        (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl5 fu5)+                          fi5)+                        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                          (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl5 fu5))+                          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                            (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4 fu4)+                              fi4)+                            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                              (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4+                                  fu4))+                              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                                (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                                  (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3+                                    fu3) fi3)+                                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                                  (T.uap1 T.mkNoSrcPos p+                                    (grangeSize T.mkNoSrcPos p)+                                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                      fl3 fu3))+                                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                                    (T.uap2 T.mkNoSrcPos p+                                      (gindex T.mkNoSrcPos p)+                                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                        fl2 fu2) fi2)+                                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                                      (T.uap1 T.mkNoSrcPos p+                                        (grangeSize T.mkNoSrcPos p)+                                        (T.con2 T.mkNoSrcPos p T.Tuple2+                                          T.aTuple2 fl2 fu2))+                                      (T.uap2 T.mkNoSrcPos p+                                        (gindex T.mkNoSrcPos p)+                                        (T.con2 T.mkNoSrcPos p T.Tuple2+                                          T.aTuple2 fl1 fu1) fi1))))))))))))))))+    hindex _ _ p = T.fatal p+    +  +  ginRange pinRange p =+    T.ufun2 a242v5v252v32inRange pinRange p hinRange+    where+    +    hinRange+      (T.R+        (T.Tuple2 (T.R (T.Tuple9 fl1 fl2 fl3 fl4 fl5 fl6 fl7 fl8 fl9) _)+          (T.R (T.Tuple9 fu1 fu2 fu3 fu4 fu5 fu6 fu7 fu8 fu9) _)) _)+      (T.R (T.Tuple9 fi1 fi2 fi3 fi4 fi5 fi6 fi7 fi8 fi9) _) p =+      T.uwrapForward p+        (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1) fi1)+            *&&+            (T.uwrapForward p+              (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2) fi2)+                  *&&+                  (T.uwrapForward p+                    (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3 fu3)+                          fi3)+                        *&&+                        (T.uwrapForward p+                          (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4+                                  fu4) fi4)+                              *&&+                              (T.uwrapForward p+                                (((T.uap2 T.mkNoSrcPos p+                                      (ginRange T.mkNoSrcPos p)+                                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                        fl5 fu5) fi5)+                                    *&&+                                    (T.uwrapForward p+                                      (((T.uap2 T.mkNoSrcPos p+                                            (ginRange T.mkNoSrcPos p)+                                            (T.con2 T.mkNoSrcPos p T.Tuple2+                                              T.aTuple2 fl6 fu6) fi6)+                                          *&&+                                          (T.uwrapForward p+                                            (((T.uap2 T.mkNoSrcPos p+                                                  (ginRange T.mkNoSrcPos p)+                                                  (T.con2 T.mkNoSrcPos p+                                                    T.Tuple2 T.aTuple2 fl7 fu7)+                                                  fi7)+                                                *&&+                                                (T.uwrapForward p+                                                  (((T.uap2 T.mkNoSrcPos p+                                                        (ginRange T.mkNoSrcPos+                                                          p)+                                                        (T.con2 T.mkNoSrcPos p+                                                          T.Tuple2 T.aTuple2 fl8+                                                          fu8) fi8)+                                                      *&&+                                                      (T.uap2 T.mkNoSrcPos p+                                                        (ginRange T.mkNoSrcPos+                                                          p)+                                                        (T.con2 T.mkNoSrcPos p+                                                          T.Tuple2 T.aTuple2 fl9+                                                          fu9) fi9)) p))) p)))+                                        p))) p))) p))) p))) p))) p)+    hinRange _ _ p = T.fatal p+    +  ++instance+  (Ix a1,Ix a2,Ix a3,Ix a4,Ix a5,Ix a6,Ix a7,Ix a8,Ix a9,Ix a10) =>+    Ix ((T.Tuple10 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10))+  where+  +  grange prange p =+    T.ufun1 a257v5v257v9range prange p hrange+    where+    +    hrange+      (T.R+        (T.Tuple2 (T.R (T.Tuple10 fl1 fl2 fl3 fl4 fl5 fl6 fl7 fl8 fl9 fl10) _)+          (T.R (T.Tuple10 fu1 fu2 fu3 fu4 fu5 fu6 fu7 fu8 fu9 fu10) _)) _) p =+      T.uap1 T.mkNoSrcPos p+        (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+          (T.ufun2 T.mkLambda T.mkNoSrcPos p+            (\ f_x f_y p ->+              T.uccase T.mkNoSrcPos p+                (let+                  v0v0v0v0v1 fi1 p =+                    T.uap1 T.mkNoSrcPos p+                      (T.uap2 T.mkNoSrcPos p+                        (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                        (T.ufun2 T.mkLambda T.mkNoSrcPos p+                          (\ f_x f_y p ->+                            T.uccase T.mkNoSrcPos p+                              (let+                                v0v0v0v0v1 fi2 p =+                                  T.uap1 T.mkNoSrcPos p+                                    (T.uap2 T.mkNoSrcPos p+                                      (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                                      (T.ufun2 T.mkLambda T.mkNoSrcPos p+                                        (\ f_x f_y p ->+                                          T.uccase T.mkNoSrcPos p+                                            (let+                                              v0v0v0v0v1 fi3 p =+                                                T.uap1 T.mkNoSrcPos p+                                                  (T.uap2 T.mkNoSrcPos p+                                                    (Hat.Prelude.g_foldr+                                                      T.mkNoSrcPos p)+                                                    (T.ufun2 T.mkLambda+                                                      T.mkNoSrcPos p+                                                      (\ f_x f_y p ->+                                                        T.uccase T.mkNoSrcPos p+                                                          (let+                                                            v0v0v0v0v1 fi4 p =+                                                              T.uap1+                                                                T.mkNoSrcPos p+                                                                (T.uap2+                                                                  T.mkNoSrcPos p+                                                                  (Hat.Prelude.g_foldr+                                                                    T.mkNoSrcPos+                                                                    p)+                                                                  (T.ufun2+                                                                    T.mkLambda+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (\ f_x f_y+                                                                      p ->+                                                                      T.uccase+                                                                        T.mkNoSrcPos+                                                                        p+                                                                        (let+                                                                          v0v0v0v0v1+                                                                            fi5+                                                                            p =+                                                                            T.uap1+                                                                              T.mkNoSrcPos+                                                                              p+                                                                              (T.uap2+                                                                                T.mkNoSrcPos+                                                                                p+                                                                                (Hat.Prelude.g_foldr+                                                                                  T.mkNoSrcPos+                                                                                  p)+                                                                                (T.ufun2+                                                                                  T.mkLambda+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  (\ f_x+                                                                                    f_y+                                                                                    p ->+                                                                                    T.uccase+                                                                                      T.mkNoSrcPos+                                                                                      p+                                                                                      (let+                                                                                        v0v0v0v0v1+                                                                                          fi6+                                                                                          p =+                                                                                          T.uap1+                                                                                            T.mkNoSrcPos+                                                                                            p+                                                                                            (T.uap2+                                                                                              T.mkNoSrcPos+                                                                                              p+                                                                                              (Hat.Prelude.g_foldr+                                                                                                T.mkNoSrcPos+                                                                                                p)+                                                                                              (T.ufun2+                                                                                                T.mkLambda+                                                                                                T.mkNoSrcPos+                                                                                                p+                                                                                                (\ f_x+                                                                                                  f_y+                                                                                                  p ->+                                                                                                  T.uccase+                                                                                                    T.mkNoSrcPos+                                                                                                    p+                                                                                                    (let+                                                                                                      v0v0v0v0v1+                                                                                                        fi7+                                                                                                        p =+                                                                                                        T.uap1+                                                                                                          T.mkNoSrcPos+                                                                                                          p+                                                                                                          (T.uap2+                                                                                                            T.mkNoSrcPos+                                                                                                            p+                                                                                                            (Hat.Prelude.g_foldr+                                                                                                              T.mkNoSrcPos+                                                                                                              p)+                                                                                                            (T.ufun2+                                                                                                              T.mkLambda+                                                                                                              T.mkNoSrcPos+                                                                                                              p+                                                                                                              (\ f_x+                                                                                                                f_y+                                                                                                                p ->+                                                                                                                T.uccase+                                                                                                                  T.mkNoSrcPos+                                                                                                                  p+                                                                                                                  (let+                                                                                                                    v0v0v0v0v1+                                                                                                                      fi8+                                                                                                                      p =+                                                                                                                      T.uap1+                                                                                                                        T.mkNoSrcPos+                                                                                                                        p+                                                                                                                        (T.uap2+                                                                                                                          T.mkNoSrcPos+                                                                                                                          p+                                                                                                                          (Hat.Prelude.g_foldr+                                                                                                                            T.mkNoSrcPos+                                                                                                                            p)+                                                                                                                          (T.ufun2+                                                                                                                            T.mkLambda+                                                                                                                            T.mkNoSrcPos+                                                                                                                            p+                                                                                                                            (\ f_x+                                                                                                                              f_y+                                                                                                                              p ->+                                                                                                                              T.uccase+                                                                                                                                T.mkNoSrcPos+                                                                                                                                p+                                                                                                                                (let+                                                                                                                                  v0v0v0v0v1+                                                                                                                                    fi9+                                                                                                                                    p =+                                                                                                                                    T.uap1+                                                                                                                                      T.mkNoSrcPos+                                                                                                                                      p+                                                                                                                                      (T.uap2+                                                                                                                                        T.mkNoSrcPos+                                                                                                                                        p+                                                                                                                                        (Hat.Prelude.g_foldr+                                                                                                                                          T.mkNoSrcPos+                                                                                                                                          p)+                                                                                                                                        (T.ufun2+                                                                                                                                          T.mkLambda+                                                                                                                                          T.mkNoSrcPos+                                                                                                                                          p+                                                                                                                                          (\ f_x+                                                                                                                                            f_y+                                                                                                                                            p ->+                                                                                                                                            T.uccase+                                                                                                                                              T.mkNoSrcPos+                                                                                                                                              p+                                                                                                                                              (let+                                                                                                                                                v0v0v0v0v1+                                                                                                                                                  fi10+                                                                                                                                                  p =+                                                                                                                                                  T.uap1+                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                    p+                                                                                                                                                    (T.pa1+                                                                                                                                                      T.Cons+                                                                                                                                                      T.cn1+                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                      p+                                                                                                                                                      T.aCons+                                                                                                                                                      (T.con10+                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                        p+                                                                                                                                                        T.Tuple10+                                                                                                                                                        T.aTuple10+                                                                                                                                                        fi1+                                                                                                                                                        fi2+                                                                                                                                                        fi3+                                                                                                                                                        fi4+                                                                                                                                                        fi5+                                                                                                                                                        fi6+                                                                                                                                                        fi7+                                                                                                                                                        fi8+                                                                                                                                                        fi9+                                                                                                                                                        fi10))+                                                                                                                                                    f_y+                                                                                                                                                v0v0v0v0v1+                                                                                                                                                  _+                                                                                                                                                  p =+                                                                                                                                                  T.projection+                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                    p+                                                                                                                                                    f_y+                                                                                                                                                in+                                                                                                                                                (v0v0v0v0v1))+                                                                                                                                              f_x))+                                                                                                                                        (T.uap1+                                                                                                                                          T.mkNoSrcPos+                                                                                                                                          p+                                                                                                                                          (grange+                                                                                                                                            T.mkNoSrcPos+                                                                                                                                            p)+                                                                                                                                          (T.con2+                                                                                                                                            T.mkNoSrcPos+                                                                                                                                            p+                                                                                                                                            T.Tuple2+                                                                                                                                            T.aTuple2+                                                                                                                                            fl10+                                                                                                                                            fu10)))+                                                                                                                                      f_y+                                                                                                                                  v0v0v0v0v1+                                                                                                                                    _+                                                                                                                                    p =+                                                                                                                                    T.projection+                                                                                                                                      T.mkNoSrcPos+                                                                                                                                      p+                                                                                                                                      f_y+                                                                                                                                  in+                                                                                                                                  (v0v0v0v0v1))+                                                                                                                                f_x))+                                                                                                                          (T.uap1+                                                                                                                            T.mkNoSrcPos+                                                                                                                            p+                                                                                                                            (grange+                                                                                                                              T.mkNoSrcPos+                                                                                                                              p)+                                                                                                                            (T.con2+                                                                                                                              T.mkNoSrcPos+                                                                                                                              p+                                                                                                                              T.Tuple2+                                                                                                                              T.aTuple2+                                                                                                                              fl9+                                                                                                                              fu9)))+                                                                                                                        f_y+                                                                                                                    v0v0v0v0v1+                                                                                                                      _+                                                                                                                      p =+                                                                                                                      T.projection+                                                                                                                        T.mkNoSrcPos+                                                                                                                        p+                                                                                                                        f_y+                                                                                                                    in+                                                                                                                    (v0v0v0v0v1))+                                                                                                                  f_x))+                                                                                                            (T.uap1+                                                                                                              T.mkNoSrcPos+                                                                                                              p+                                                                                                              (grange+                                                                                                                T.mkNoSrcPos+                                                                                                                p)+                                                                                                              (T.con2+                                                                                                                T.mkNoSrcPos+                                                                                                                p+                                                                                                                T.Tuple2+                                                                                                                T.aTuple2+                                                                                                                fl8+                                                                                                                fu8)))+                                                                                                          f_y+                                                                                                      v0v0v0v0v1+                                                                                                        _+                                                                                                        p =+                                                                                                        T.projection+                                                                                                          T.mkNoSrcPos+                                                                                                          p+                                                                                                          f_y+                                                                                                      in+                                                                                                      (v0v0v0v0v1))+                                                                                                    f_x))+                                                                                              (T.uap1+                                                                                                T.mkNoSrcPos+                                                                                                p+                                                                                                (grange+                                                                                                  T.mkNoSrcPos+                                                                                                  p)+                                                                                                (T.con2+                                                                                                  T.mkNoSrcPos+                                                                                                  p+                                                                                                  T.Tuple2+                                                                                                  T.aTuple2+                                                                                                  fl7+                                                                                                  fu7)))+                                                                                            f_y+                                                                                        v0v0v0v0v1+                                                                                          _+                                                                                          p =+                                                                                          T.projection+                                                                                            T.mkNoSrcPos+                                                                                            p+                                                                                            f_y+                                                                                        in+                                                                                        (v0v0v0v0v1))+                                                                                      f_x))+                                                                                (T.uap1+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  (grange+                                                                                    T.mkNoSrcPos+                                                                                    p)+                                                                                  (T.con2+                                                                                    T.mkNoSrcPos+                                                                                    p+                                                                                    T.Tuple2+                                                                                    T.aTuple2+                                                                                    fl6+                                                                                    fu6)))+                                                                              f_y+                                                                          v0v0v0v0v1+                                                                            _+                                                                            p =+                                                                            T.projection+                                                                              T.mkNoSrcPos+                                                                              p+                                                                              f_y+                                                                          in+                                                                          (v0v0v0v0v1))+                                                                        f_x))+                                                                  (T.uap1+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (grange+                                                                      T.mkNoSrcPos+                                                                      p)+                                                                    (T.con2+                                                                      T.mkNoSrcPos+                                                                      p T.Tuple2+                                                                      T.aTuple2+                                                                      fl5 fu5)))+                                                                f_y+                                                            v0v0v0v0v1 _ p =+                                                              T.projection+                                                                T.mkNoSrcPos p+                                                                f_y in+                                                            (v0v0v0v0v1)) f_x))+                                                    (T.uap1 T.mkNoSrcPos p+                                                      (grange T.mkNoSrcPos p)+                                                      (T.con2 T.mkNoSrcPos p+                                                        T.Tuple2 T.aTuple2 fl4+                                                        fu4))) f_y+                                              v0v0v0v0v1 _ p =+                                                T.projection T.mkNoSrcPos p f_y+                                              in (v0v0v0v0v1)) f_x))+                                      (T.uap1 T.mkNoSrcPos p+                                        (grange T.mkNoSrcPos p)+                                        (T.con2 T.mkNoSrcPos p T.Tuple2+                                          T.aTuple2 fl3 fu3))) f_y+                                v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y+                                in (v0v0v0v0v1)) f_x))+                        (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2)))+                      f_y+                  v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in+                  (v0v0v0v0v1)) f_x))+          (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1)))+        (T.fromExpList T.mkNoSrcPos p [])+    hrange _ p = T.fatal p+    +  +  gindex pindex p =+    T.ufun2 a271v5v283v36index pindex p hindex+    where+    +    hindex+      (T.R+        (T.Tuple2 (T.R (T.Tuple10 fl1 fl2 fl3 fl4 fl5 fl6 fl7 fl8 fl9 fl10) _)+          (T.R (T.Tuple10 fu1 fu2 fu3 fu4 fu5 fu6 fu7 fu8 fu9 fu10) _)) _)+      (T.R (T.Tuple10 fi1 fi2 fi3 fi4 fi5 fi6 fi7 fi8 fi9 fi10) _) p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+        (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl10 fu10) fi10)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+          (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl10 fu10))+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+            (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl9 fu9) fi9)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+              (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl9 fu9))+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                  (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl8 fu8) fi8)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                  (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl8 fu8))+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                    (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl7 fu7) fi7)+                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                      (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                        (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl7 fu7))+                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                        (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl6 fu6)+                          fi6)+                        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                          (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl6 fu6))+                          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                            (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl5 fu5)+                              fi5)+                            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                              (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl5+                                  fu5))+                              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                                (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                                  (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4+                                    fu4) fi4)+                                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                                  (T.uap1 T.mkNoSrcPos p+                                    (grangeSize T.mkNoSrcPos p)+                                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                      fl4 fu4))+                                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                                    (T.uap2 T.mkNoSrcPos p+                                      (gindex T.mkNoSrcPos p)+                                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                        fl3 fu3) fi3)+                                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                                      (T.uap1 T.mkNoSrcPos p+                                        (grangeSize T.mkNoSrcPos p)+                                        (T.con2 T.mkNoSrcPos p T.Tuple2+                                          T.aTuple2 fl3 fu3))+                                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                                        (T.uap2 T.mkNoSrcPos p+                                          (gindex T.mkNoSrcPos p)+                                          (T.con2 T.mkNoSrcPos p T.Tuple2+                                            T.aTuple2 fl2 fu2) fi2)+                                        (T.uap2 T.mkNoSrcPos p+                                          (T.mkNoSrcPos !* p)+                                          (T.uap1 T.mkNoSrcPos p+                                            (grangeSize T.mkNoSrcPos p)+                                            (T.con2 T.mkNoSrcPos p T.Tuple2+                                              T.aTuple2 fl2 fu2))+                                          (T.uap2 T.mkNoSrcPos p+                                            (gindex T.mkNoSrcPos p)+                                            (T.con2 T.mkNoSrcPos p T.Tuple2+                                              T.aTuple2 fl1 fu1)+                                            fi1))))))))))))))))))+    hindex _ _ p = T.fatal p+    +  +  ginRange pinRange p =+    T.ufun2 a285v5v297v35inRange pinRange p hinRange+    where+    +    hinRange+      (T.R+        (T.Tuple2 (T.R (T.Tuple10 fl1 fl2 fl3 fl4 fl5 fl6 fl7 fl8 fl9 fl10) _)+          (T.R (T.Tuple10 fu1 fu2 fu3 fu4 fu5 fu6 fu7 fu8 fu9 fu10) _)) _)+      (T.R (T.Tuple10 fi1 fi2 fi3 fi4 fi5 fi6 fi7 fi8 fi9 fi10) _) p =+      T.uwrapForward p+        (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1) fi1)+            *&&+            (T.uwrapForward p+              (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2) fi2)+                  *&&+                  (T.uwrapForward p+                    (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3 fu3)+                          fi3)+                        *&&+                        (T.uwrapForward p+                          (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4+                                  fu4) fi4)+                              *&&+                              (T.uwrapForward p+                                (((T.uap2 T.mkNoSrcPos p+                                      (ginRange T.mkNoSrcPos p)+                                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                        fl5 fu5) fi5)+                                    *&&+                                    (T.uwrapForward p+                                      (((T.uap2 T.mkNoSrcPos p+                                            (ginRange T.mkNoSrcPos p)+                                            (T.con2 T.mkNoSrcPos p T.Tuple2+                                              T.aTuple2 fl6 fu6) fi6)+                                          *&&+                                          (T.uwrapForward p+                                            (((T.uap2 T.mkNoSrcPos p+                                                  (ginRange T.mkNoSrcPos p)+                                                  (T.con2 T.mkNoSrcPos p+                                                    T.Tuple2 T.aTuple2 fl7 fu7)+                                                  fi7)+                                                *&&+                                                (T.uwrapForward p+                                                  (((T.uap2 T.mkNoSrcPos p+                                                        (ginRange T.mkNoSrcPos+                                                          p)+                                                        (T.con2 T.mkNoSrcPos p+                                                          T.Tuple2 T.aTuple2 fl8+                                                          fu8) fi8)+                                                      *&&+                                                      (T.uwrapForward p+                                                        (((T.uap2 T.mkNoSrcPos p+                                                              (ginRange+                                                                T.mkNoSrcPos p)+                                                              (T.con2+                                                                T.mkNoSrcPos p+                                                                T.Tuple2+                                                                T.aTuple2 fl9+                                                                fu9) fi9)+                                                            *&&+                                                            (T.uap2 T.mkNoSrcPos+                                                              p+                                                              (ginRange+                                                                T.mkNoSrcPos p)+                                                              (T.con2+                                                                T.mkNoSrcPos p+                                                                T.Tuple2+                                                                T.aTuple2 fl10+                                                                fu10) fi10))+                                                          p))) p))) p))) p)))+                                  p))) p))) p))) p))) p)+    hinRange _ _ p = T.fatal p+    +  ++instance+  (Ix a1,Ix a2,Ix a3,Ix a4,Ix a5,Ix a6,Ix a7,Ix a8,Ix a9,Ix a10,Ix a11) =>+    Ix ((T.Tuple11 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11))+  where+  +  grange prange p =+    T.ufun1 a302v5v302v9range prange p hrange+    where+    +    hrange+      (T.R+        (T.Tuple2+          (T.R (T.Tuple11 fl1 fl2 fl3 fl4 fl5 fl6 fl7 fl8 fl9 fl10 fl11) _)+          (T.R (T.Tuple11 fu1 fu2 fu3 fu4 fu5 fu6 fu7 fu8 fu9 fu10 fu11) _)) _)+      p =+      T.uap1 T.mkNoSrcPos p+        (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+          (T.ufun2 T.mkLambda T.mkNoSrcPos p+            (\ f_x f_y p ->+              T.uccase T.mkNoSrcPos p+                (let+                  v0v0v0v0v1 fi1 p =+                    T.uap1 T.mkNoSrcPos p+                      (T.uap2 T.mkNoSrcPos p+                        (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                        (T.ufun2 T.mkLambda T.mkNoSrcPos p+                          (\ f_x f_y p ->+                            T.uccase T.mkNoSrcPos p+                              (let+                                v0v0v0v0v1 fi2 p =+                                  T.uap1 T.mkNoSrcPos p+                                    (T.uap2 T.mkNoSrcPos p+                                      (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                                      (T.ufun2 T.mkLambda T.mkNoSrcPos p+                                        (\ f_x f_y p ->+                                          T.uccase T.mkNoSrcPos p+                                            (let+                                              v0v0v0v0v1 fi3 p =+                                                T.uap1 T.mkNoSrcPos p+                                                  (T.uap2 T.mkNoSrcPos p+                                                    (Hat.Prelude.g_foldr+                                                      T.mkNoSrcPos p)+                                                    (T.ufun2 T.mkLambda+                                                      T.mkNoSrcPos p+                                                      (\ f_x f_y p ->+                                                        T.uccase T.mkNoSrcPos p+                                                          (let+                                                            v0v0v0v0v1 fi4 p =+                                                              T.uap1+                                                                T.mkNoSrcPos p+                                                                (T.uap2+                                                                  T.mkNoSrcPos p+                                                                  (Hat.Prelude.g_foldr+                                                                    T.mkNoSrcPos+                                                                    p)+                                                                  (T.ufun2+                                                                    T.mkLambda+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (\ f_x f_y+                                                                      p ->+                                                                      T.uccase+                                                                        T.mkNoSrcPos+                                                                        p+                                                                        (let+                                                                          v0v0v0v0v1+                                                                            fi5+                                                                            p =+                                                                            T.uap1+                                                                              T.mkNoSrcPos+                                                                              p+                                                                              (T.uap2+                                                                                T.mkNoSrcPos+                                                                                p+                                                                                (Hat.Prelude.g_foldr+                                                                                  T.mkNoSrcPos+                                                                                  p)+                                                                                (T.ufun2+                                                                                  T.mkLambda+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  (\ f_x+                                                                                    f_y+                                                                                    p ->+                                                                                    T.uccase+                                                                                      T.mkNoSrcPos+                                                                                      p+                                                                                      (let+                                                                                        v0v0v0v0v1+                                                                                          fi6+                                                                                          p =+                                                                                          T.uap1+                                                                                            T.mkNoSrcPos+                                                                                            p+                                                                                            (T.uap2+                                                                                              T.mkNoSrcPos+                                                                                              p+                                                                                              (Hat.Prelude.g_foldr+                                                                                                T.mkNoSrcPos+                                                                                                p)+                                                                                              (T.ufun2+                                                                                                T.mkLambda+                                                                                                T.mkNoSrcPos+                                                                                                p+                                                                                                (\ f_x+                                                                                                  f_y+                                                                                                  p ->+                                                                                                  T.uccase+                                                                                                    T.mkNoSrcPos+                                                                                                    p+                                                                                                    (let+                                                                                                      v0v0v0v0v1+                                                                                                        fi7+                                                                                                        p =+                                                                                                        T.uap1+                                                                                                          T.mkNoSrcPos+                                                                                                          p+                                                                                                          (T.uap2+                                                                                                            T.mkNoSrcPos+                                                                                                            p+                                                                                                            (Hat.Prelude.g_foldr+                                                                                                              T.mkNoSrcPos+                                                                                                              p)+                                                                                                            (T.ufun2+                                                                                                              T.mkLambda+                                                                                                              T.mkNoSrcPos+                                                                                                              p+                                                                                                              (\ f_x+                                                                                                                f_y+                                                                                                                p ->+                                                                                                                T.uccase+                                                                                                                  T.mkNoSrcPos+                                                                                                                  p+                                                                                                                  (let+                                                                                                                    v0v0v0v0v1+                                                                                                                      fi8+                                                                                                                      p =+                                                                                                                      T.uap1+                                                                                                                        T.mkNoSrcPos+                                                                                                                        p+                                                                                                                        (T.uap2+                                                                                                                          T.mkNoSrcPos+                                                                                                                          p+                                                                                                                          (Hat.Prelude.g_foldr+                                                                                                                            T.mkNoSrcPos+                                                                                                                            p)+                                                                                                                          (T.ufun2+                                                                                                                            T.mkLambda+                                                                                                                            T.mkNoSrcPos+                                                                                                                            p+                                                                                                                            (\ f_x+                                                                                                                              f_y+                                                                                                                              p ->+                                                                                                                              T.uccase+                                                                                                                                T.mkNoSrcPos+                                                                                                                                p+                                                                                                                                (let+                                                                                                                                  v0v0v0v0v1+                                                                                                                                    fi9+                                                                                                                                    p =+                                                                                                                                    T.uap1+                                                                                                                                      T.mkNoSrcPos+                                                                                                                                      p+                                                                                                                                      (T.uap2+                                                                                                                                        T.mkNoSrcPos+                                                                                                                                        p+                                                                                                                                        (Hat.Prelude.g_foldr+                                                                                                                                          T.mkNoSrcPos+                                                                                                                                          p)+                                                                                                                                        (T.ufun2+                                                                                                                                          T.mkLambda+                                                                                                                                          T.mkNoSrcPos+                                                                                                                                          p+                                                                                                                                          (\ f_x+                                                                                                                                            f_y+                                                                                                                                            p ->+                                                                                                                                            T.uccase+                                                                                                                                              T.mkNoSrcPos+                                                                                                                                              p+                                                                                                                                              (let+                                                                                                                                                v0v0v0v0v1+                                                                                                                                                  fi10+                                                                                                                                                  p =+                                                                                                                                                  T.uap1+                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                    p+                                                                                                                                                    (T.uap2+                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                      p+                                                                                                                                                      (Hat.Prelude.g_foldr+                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                        p)+                                                                                                                                                      (T.ufun2+                                                                                                                                                        T.mkLambda+                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                        p+                                                                                                                                                        (\ f_x+                                                                                                                                                          f_y+                                                                                                                                                          p ->+                                                                                                                                                          T.uccase+                                                                                                                                                            T.mkNoSrcPos+                                                                                                                                                            p+                                                                                                                                                            (let+                                                                                                                                                              v0v0v0v0v1+                                                                                                                                                                fi11+                                                                                                                                                                p =+                                                                                                                                                                T.uap1+                                                                                                                                                                  T.mkNoSrcPos+                                                                                                                                                                  p+                                                                                                                                                                  (T.pa1+                                                                                                                                                                    T.Cons+                                                                                                                                                                    T.cn1+                                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                                    p+                                                                                                                                                                    T.aCons+                                                                                                                                                                    (T.con11+                                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                                      p+                                                                                                                                                                      T.Tuple11+                                                                                                                                                                      T.aTuple11+                                                                                                                                                                      fi1+                                                                                                                                                                      fi2+                                                                                                                                                                      fi3+                                                                                                                                                                      fi4+                                                                                                                                                                      fi5+                                                                                                                                                                      fi6+                                                                                                                                                                      fi7+                                                                                                                                                                      fi8+                                                                                                                                                                      fi9+                                                                                                                                                                      fi10+                                                                                                                                                                      fi11))+                                                                                                                                                                  f_y+                                                                                                                                                              v0v0v0v0v1+                                                                                                                                                                _+                                                                                                                                                                p =+                                                                                                                                                                T.projection+                                                                                                                                                                  T.mkNoSrcPos+                                                                                                                                                                  p+                                                                                                                                                                  f_y+                                                                                                                                                              in+                                                                                                                                                              (v0v0v0v0v1))+                                                                                                                                                            f_x))+                                                                                                                                                      (T.uap1+                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                        p+                                                                                                                                                        (grange+                                                                                                                                                          T.mkNoSrcPos+                                                                                                                                                          p)+                                                                                                                                                        (T.con2+                                                                                                                                                          T.mkNoSrcPos+                                                                                                                                                          p+                                                                                                                                                          T.Tuple2+                                                                                                                                                          T.aTuple2+                                                                                                                                                          fl11+                                                                                                                                                          fu11)))+                                                                                                                                                    f_y+                                                                                                                                                v0v0v0v0v1+                                                                                                                                                  _+                                                                                                                                                  p =+                                                                                                                                                  T.projection+                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                    p+                                                                                                                                                    f_y+                                                                                                                                                in+                                                                                                                                                (v0v0v0v0v1))+                                                                                                                                              f_x))+                                                                                                                                        (T.uap1+                                                                                                                                          T.mkNoSrcPos+                                                                                                                                          p+                                                                                                                                          (grange+                                                                                                                                            T.mkNoSrcPos+                                                                                                                                            p)+                                                                                                                                          (T.con2+                                                                                                                                            T.mkNoSrcPos+                                                                                                                                            p+                                                                                                                                            T.Tuple2+                                                                                                                                            T.aTuple2+                                                                                                                                            fl10+                                                                                                                                            fu10)))+                                                                                                                                      f_y+                                                                                                                                  v0v0v0v0v1+                                                                                                                                    _+                                                                                                                                    p =+                                                                                                                                    T.projection+                                                                                                                                      T.mkNoSrcPos+                                                                                                                                      p+                                                                                                                                      f_y+                                                                                                                                  in+                                                                                                                                  (v0v0v0v0v1))+                                                                                                                                f_x))+                                                                                                                          (T.uap1+                                                                                                                            T.mkNoSrcPos+                                                                                                                            p+                                                                                                                            (grange+                                                                                                                              T.mkNoSrcPos+                                                                                                                              p)+                                                                                                                            (T.con2+                                                                                                                              T.mkNoSrcPos+                                                                                                                              p+                                                                                                                              T.Tuple2+                                                                                                                              T.aTuple2+                                                                                                                              fl9+                                                                                                                              fu9)))+                                                                                                                        f_y+                                                                                                                    v0v0v0v0v1+                                                                                                                      _+                                                                                                                      p =+                                                                                                                      T.projection+                                                                                                                        T.mkNoSrcPos+                                                                                                                        p+                                                                                                                        f_y+                                                                                                                    in+                                                                                                                    (v0v0v0v0v1))+                                                                                                                  f_x))+                                                                                                            (T.uap1+                                                                                                              T.mkNoSrcPos+                                                                                                              p+                                                                                                              (grange+                                                                                                                T.mkNoSrcPos+                                                                                                                p)+                                                                                                              (T.con2+                                                                                                                T.mkNoSrcPos+                                                                                                                p+                                                                                                                T.Tuple2+                                                                                                                T.aTuple2+                                                                                                                fl8+                                                                                                                fu8)))+                                                                                                          f_y+                                                                                                      v0v0v0v0v1+                                                                                                        _+                                                                                                        p =+                                                                                                        T.projection+                                                                                                          T.mkNoSrcPos+                                                                                                          p+                                                                                                          f_y+                                                                                                      in+                                                                                                      (v0v0v0v0v1))+                                                                                                    f_x))+                                                                                              (T.uap1+                                                                                                T.mkNoSrcPos+                                                                                                p+                                                                                                (grange+                                                                                                  T.mkNoSrcPos+                                                                                                  p)+                                                                                                (T.con2+                                                                                                  T.mkNoSrcPos+                                                                                                  p+                                                                                                  T.Tuple2+                                                                                                  T.aTuple2+                                                                                                  fl7+                                                                                                  fu7)))+                                                                                            f_y+                                                                                        v0v0v0v0v1+                                                                                          _+                                                                                          p =+                                                                                          T.projection+                                                                                            T.mkNoSrcPos+                                                                                            p+                                                                                            f_y+                                                                                        in+                                                                                        (v0v0v0v0v1))+                                                                                      f_x))+                                                                                (T.uap1+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  (grange+                                                                                    T.mkNoSrcPos+                                                                                    p)+                                                                                  (T.con2+                                                                                    T.mkNoSrcPos+                                                                                    p+                                                                                    T.Tuple2+                                                                                    T.aTuple2+                                                                                    fl6+                                                                                    fu6)))+                                                                              f_y+                                                                          v0v0v0v0v1+                                                                            _+                                                                            p =+                                                                            T.projection+                                                                              T.mkNoSrcPos+                                                                              p+                                                                              f_y+                                                                          in+                                                                          (v0v0v0v0v1))+                                                                        f_x))+                                                                  (T.uap1+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (grange+                                                                      T.mkNoSrcPos+                                                                      p)+                                                                    (T.con2+                                                                      T.mkNoSrcPos+                                                                      p T.Tuple2+                                                                      T.aTuple2+                                                                      fl5 fu5)))+                                                                f_y+                                                            v0v0v0v0v1 _ p =+                                                              T.projection+                                                                T.mkNoSrcPos p+                                                                f_y in+                                                            (v0v0v0v0v1)) f_x))+                                                    (T.uap1 T.mkNoSrcPos p+                                                      (grange T.mkNoSrcPos p)+                                                      (T.con2 T.mkNoSrcPos p+                                                        T.Tuple2 T.aTuple2 fl4+                                                        fu4))) f_y+                                              v0v0v0v0v1 _ p =+                                                T.projection T.mkNoSrcPos p f_y+                                              in (v0v0v0v0v1)) f_x))+                                      (T.uap1 T.mkNoSrcPos p+                                        (grange T.mkNoSrcPos p)+                                        (T.con2 T.mkNoSrcPos p T.Tuple2+                                          T.aTuple2 fl3 fu3))) f_y+                                v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y+                                in (v0v0v0v0v1)) f_x))+                        (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2)))+                      f_y+                  v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in+                  (v0v0v0v0v1)) f_x))+          (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1)))+        (T.fromExpList T.mkNoSrcPos p [])+    hrange _ p = T.fatal p+    +  +  gindex pindex p =+    T.ufun2 a317v5v330v36index pindex p hindex+    where+    +    hindex+      (T.R+        (T.Tuple2+          (T.R (T.Tuple11 fl1 fl2 fl3 fl4 fl5 fl6 fl7 fl8 fl9 fl10 fl11) _)+          (T.R (T.Tuple11 fu1 fu2 fu3 fu4 fu5 fu6 fu7 fu8 fu9 fu10 fu11) _)) _)+      (T.R (T.Tuple11 fi1 fi2 fi3 fi4 fi5 fi6 fi7 fi8 fi9 fi10 fi11) _) p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+        (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl11 fu11) fi11)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+          (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl11 fu11))+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+            (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl10 fu10) fi10)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+              (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl10 fu10))+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                  (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl9 fu9) fi9)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                  (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl9 fu9))+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                    (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl8 fu8) fi8)+                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                      (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                        (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl8 fu8))+                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                        (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl7 fu7)+                          fi7)+                        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                          (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl7 fu7))+                          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                            (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl6 fu6)+                              fi6)+                            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                              (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl6+                                  fu6))+                              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                                (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                                  (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl5+                                    fu5) fi5)+                                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                                  (T.uap1 T.mkNoSrcPos p+                                    (grangeSize T.mkNoSrcPos p)+                                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                      fl5 fu5))+                                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                                    (T.uap2 T.mkNoSrcPos p+                                      (gindex T.mkNoSrcPos p)+                                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                        fl4 fu4) fi4)+                                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                                      (T.uap1 T.mkNoSrcPos p+                                        (grangeSize T.mkNoSrcPos p)+                                        (T.con2 T.mkNoSrcPos p T.Tuple2+                                          T.aTuple2 fl4 fu4))+                                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                                        (T.uap2 T.mkNoSrcPos p+                                          (gindex T.mkNoSrcPos p)+                                          (T.con2 T.mkNoSrcPos p T.Tuple2+                                            T.aTuple2 fl3 fu3) fi3)+                                        (T.uap2 T.mkNoSrcPos p+                                          (T.mkNoSrcPos !* p)+                                          (T.uap1 T.mkNoSrcPos p+                                            (grangeSize T.mkNoSrcPos p)+                                            (T.con2 T.mkNoSrcPos p T.Tuple2+                                              T.aTuple2 fl3 fu3))+                                          (T.uap2 T.mkNoSrcPos p+                                            (T.mkNoSrcPos !+ p)+                                            (T.uap2 T.mkNoSrcPos p+                                              (gindex T.mkNoSrcPos p)+                                              (T.con2 T.mkNoSrcPos p T.Tuple2+                                                T.aTuple2 fl2 fu2) fi2)+                                            (T.uap2 T.mkNoSrcPos p+                                              (T.mkNoSrcPos !* p)+                                              (T.uap1 T.mkNoSrcPos p+                                                (grangeSize T.mkNoSrcPos p)+                                                (T.con2 T.mkNoSrcPos p T.Tuple2+                                                  T.aTuple2 fl2 fu2))+                                              (T.uap2 T.mkNoSrcPos p+                                                (gindex T.mkNoSrcPos p)+                                                (T.con2 T.mkNoSrcPos p T.Tuple2+                                                  T.aTuple2 fl1 fu1)+                                                fi1))))))))))))))))))))+    hindex _ _ p = T.fatal p+    +  +  ginRange pinRange p =+    T.ufun2 a332v5v345v35inRange pinRange p hinRange+    where+    +    hinRange+      (T.R+        (T.Tuple2+          (T.R (T.Tuple11 fl1 fl2 fl3 fl4 fl5 fl6 fl7 fl8 fl9 fl10 fl11) _)+          (T.R (T.Tuple11 fu1 fu2 fu3 fu4 fu5 fu6 fu7 fu8 fu9 fu10 fu11) _)) _)+      (T.R (T.Tuple11 fi1 fi2 fi3 fi4 fi5 fi6 fi7 fi8 fi9 fi10 fi11) _) p =+      T.uwrapForward p+        (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1) fi1)+            *&&+            (T.uwrapForward p+              (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2) fi2)+                  *&&+                  (T.uwrapForward p+                    (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3 fu3)+                          fi3)+                        *&&+                        (T.uwrapForward p+                          (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4+                                  fu4) fi4)+                              *&&+                              (T.uwrapForward p+                                (((T.uap2 T.mkNoSrcPos p+                                      (ginRange T.mkNoSrcPos p)+                                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                        fl5 fu5) fi5)+                                    *&&+                                    (T.uwrapForward p+                                      (((T.uap2 T.mkNoSrcPos p+                                            (ginRange T.mkNoSrcPos p)+                                            (T.con2 T.mkNoSrcPos p T.Tuple2+                                              T.aTuple2 fl6 fu6) fi6)+                                          *&&+                                          (T.uwrapForward p+                                            (((T.uap2 T.mkNoSrcPos p+                                                  (ginRange T.mkNoSrcPos p)+                                                  (T.con2 T.mkNoSrcPos p+                                                    T.Tuple2 T.aTuple2 fl7 fu7)+                                                  fi7)+                                                *&&+                                                (T.uwrapForward p+                                                  (((T.uap2 T.mkNoSrcPos p+                                                        (ginRange T.mkNoSrcPos+                                                          p)+                                                        (T.con2 T.mkNoSrcPos p+                                                          T.Tuple2 T.aTuple2 fl8+                                                          fu8) fi8)+                                                      *&&+                                                      (T.uwrapForward p+                                                        (((T.uap2 T.mkNoSrcPos p+                                                              (ginRange+                                                                T.mkNoSrcPos p)+                                                              (T.con2+                                                                T.mkNoSrcPos p+                                                                T.Tuple2+                                                                T.aTuple2 fl9+                                                                fu9) fi9)+                                                            *&&+                                                            (T.uwrapForward p+                                                              (((T.uap2+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (ginRange+                                                                      T.mkNoSrcPos+                                                                      p)+                                                                    (T.con2+                                                                      T.mkNoSrcPos+                                                                      p T.Tuple2+                                                                      T.aTuple2+                                                                      fl10 fu10)+                                                                    fi10)+                                                                  *&&+                                                                  (T.uap2+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (ginRange+                                                                      T.mkNoSrcPos+                                                                      p)+                                                                    (T.con2+                                                                      T.mkNoSrcPos+                                                                      p T.Tuple2+                                                                      T.aTuple2+                                                                      fl11 fu11)+                                                                    fi11)) p)))+                                                          p))) p))) p))) p)))+                                  p))) p))) p))) p))) p)+    hinRange _ _ p = T.fatal p+    +  ++instance+  (Ix a1,Ix a2,Ix a3,Ix a4,Ix a5,Ix a6,Ix a7,Ix a8,Ix a9,Ix a10,Ix a11+      ,Ix a12) => Ix ((T.Tuple12 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12))+  where+  +  grange prange p =+    T.ufun1 a350v5v350v9range prange p hrange+    where+    +    hrange+      (T.R+        (T.Tuple2+          (T.R (T.Tuple12 fl1 fl2 fl3 fl4 fl5 fl6 fl7 fl8 fl9 fl10 fl11 fl12) _)+          (T.R (T.Tuple12 fu1 fu2 fu3 fu4 fu5 fu6 fu7 fu8 fu9 fu10 fu11 fu12)+            _)) _) p =+      T.uap1 T.mkNoSrcPos p+        (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+          (T.ufun2 T.mkLambda T.mkNoSrcPos p+            (\ f_x f_y p ->+              T.uccase T.mkNoSrcPos p+                (let+                  v0v0v0v0v1 fi1 p =+                    T.uap1 T.mkNoSrcPos p+                      (T.uap2 T.mkNoSrcPos p+                        (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                        (T.ufun2 T.mkLambda T.mkNoSrcPos p+                          (\ f_x f_y p ->+                            T.uccase T.mkNoSrcPos p+                              (let+                                v0v0v0v0v1 fi2 p =+                                  T.uap1 T.mkNoSrcPos p+                                    (T.uap2 T.mkNoSrcPos p+                                      (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                                      (T.ufun2 T.mkLambda T.mkNoSrcPos p+                                        (\ f_x f_y p ->+                                          T.uccase T.mkNoSrcPos p+                                            (let+                                              v0v0v0v0v1 fi3 p =+                                                T.uap1 T.mkNoSrcPos p+                                                  (T.uap2 T.mkNoSrcPos p+                                                    (Hat.Prelude.g_foldr+                                                      T.mkNoSrcPos p)+                                                    (T.ufun2 T.mkLambda+                                                      T.mkNoSrcPos p+                                                      (\ f_x f_y p ->+                                                        T.uccase T.mkNoSrcPos p+                                                          (let+                                                            v0v0v0v0v1 fi4 p =+                                                              T.uap1+                                                                T.mkNoSrcPos p+                                                                (T.uap2+                                                                  T.mkNoSrcPos p+                                                                  (Hat.Prelude.g_foldr+                                                                    T.mkNoSrcPos+                                                                    p)+                                                                  (T.ufun2+                                                                    T.mkLambda+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (\ f_x f_y+                                                                      p ->+                                                                      T.uccase+                                                                        T.mkNoSrcPos+                                                                        p+                                                                        (let+                                                                          v0v0v0v0v1+                                                                            fi5+                                                                            p =+                                                                            T.uap1+                                                                              T.mkNoSrcPos+                                                                              p+                                                                              (T.uap2+                                                                                T.mkNoSrcPos+                                                                                p+                                                                                (Hat.Prelude.g_foldr+                                                                                  T.mkNoSrcPos+                                                                                  p)+                                                                                (T.ufun2+                                                                                  T.mkLambda+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  (\ f_x+                                                                                    f_y+                                                                                    p ->+                                                                                    T.uccase+                                                                                      T.mkNoSrcPos+                                                                                      p+                                                                                      (let+                                                                                        v0v0v0v0v1+                                                                                          fi6+                                                                                          p =+                                                                                          T.uap1+                                                                                            T.mkNoSrcPos+                                                                                            p+                                                                                            (T.uap2+                                                                                              T.mkNoSrcPos+                                                                                              p+                                                                                              (Hat.Prelude.g_foldr+                                                                                                T.mkNoSrcPos+                                                                                                p)+                                                                                              (T.ufun2+                                                                                                T.mkLambda+                                                                                                T.mkNoSrcPos+                                                                                                p+                                                                                                (\ f_x+                                                                                                  f_y+                                                                                                  p ->+                                                                                                  T.uccase+                                                                                                    T.mkNoSrcPos+                                                                                                    p+                                                                                                    (let+                                                                                                      v0v0v0v0v1+                                                                                                        fi7+                                                                                                        p =+                                                                                                        T.uap1+                                                                                                          T.mkNoSrcPos+                                                                                                          p+                                                                                                          (T.uap2+                                                                                                            T.mkNoSrcPos+                                                                                                            p+                                                                                                            (Hat.Prelude.g_foldr+                                                                                                              T.mkNoSrcPos+                                                                                                              p)+                                                                                                            (T.ufun2+                                                                                                              T.mkLambda+                                                                                                              T.mkNoSrcPos+                                                                                                              p+                                                                                                              (\ f_x+                                                                                                                f_y+                                                                                                                p ->+                                                                                                                T.uccase+                                                                                                                  T.mkNoSrcPos+                                                                                                                  p+                                                                                                                  (let+                                                                                                                    v0v0v0v0v1+                                                                                                                      fi8+                                                                                                                      p =+                                                                                                                      T.uap1+                                                                                                                        T.mkNoSrcPos+                                                                                                                        p+                                                                                                                        (T.uap2+                                                                                                                          T.mkNoSrcPos+                                                                                                                          p+                                                                                                                          (Hat.Prelude.g_foldr+                                                                                                                            T.mkNoSrcPos+                                                                                                                            p)+                                                                                                                          (T.ufun2+                                                                                                                            T.mkLambda+                                                                                                                            T.mkNoSrcPos+                                                                                                                            p+                                                                                                                            (\ f_x+                                                                                                                              f_y+                                                                                                                              p ->+                                                                                                                              T.uccase+                                                                                                                                T.mkNoSrcPos+                                                                                                                                p+                                                                                                                                (let+                                                                                                                                  v0v0v0v0v1+                                                                                                                                    fi9+                                                                                                                                    p =+                                                                                                                                    T.uap1+                                                                                                                                      T.mkNoSrcPos+                                                                                                                                      p+                                                                                                                                      (T.uap2+                                                                                                                                        T.mkNoSrcPos+                                                                                                                                        p+                                                                                                                                        (Hat.Prelude.g_foldr+                                                                                                                                          T.mkNoSrcPos+                                                                                                                                          p)+                                                                                                                                        (T.ufun2+                                                                                                                                          T.mkLambda+                                                                                                                                          T.mkNoSrcPos+                                                                                                                                          p+                                                                                                                                          (\ f_x+                                                                                                                                            f_y+                                                                                                                                            p ->+                                                                                                                                            T.uccase+                                                                                                                                              T.mkNoSrcPos+                                                                                                                                              p+                                                                                                                                              (let+                                                                                                                                                v0v0v0v0v1+                                                                                                                                                  fi10+                                                                                                                                                  p =+                                                                                                                                                  T.uap1+                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                    p+                                                                                                                                                    (T.uap2+                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                      p+                                                                                                                                                      (Hat.Prelude.g_foldr+                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                        p)+                                                                                                                                                      (T.ufun2+                                                                                                                                                        T.mkLambda+                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                        p+                                                                                                                                                        (\ f_x+                                                                                                                                                          f_y+                                                                                                                                                          p ->+                                                                                                                                                          T.uccase+                                                                                                                                                            T.mkNoSrcPos+                                                                                                                                                            p+                                                                                                                                                            (let+                                                                                                                                                              v0v0v0v0v1+                                                                                                                                                                fi11+                                                                                                                                                                p =+                                                                                                                                                                T.uap1+                                                                                                                                                                  T.mkNoSrcPos+                                                                                                                                                                  p+                                                                                                                                                                  (T.uap2+                                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                                    p+                                                                                                                                                                    (Hat.Prelude.g_foldr+                                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                                      p)+                                                                                                                                                                    (T.ufun2+                                                                                                                                                                      T.mkLambda+                                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                                      p+                                                                                                                                                                      (\ f_x+                                                                                                                                                                        f_y+                                                                                                                                                                        p ->+                                                                                                                                                                        T.uccase+                                                                                                                                                                          T.mkNoSrcPos+                                                                                                                                                                          p+                                                                                                                                                                          (let+                                                                                                                                                                            v0v0v0v0v1+                                                                                                                                                                              fi12+                                                                                                                                                                              p =+                                                                                                                                                                              T.uap1+                                                                                                                                                                                T.mkNoSrcPos+                                                                                                                                                                                p+                                                                                                                                                                                (T.pa1+                                                                                                                                                                                  T.Cons+                                                                                                                                                                                  T.cn1+                                                                                                                                                                                  T.mkNoSrcPos+                                                                                                                                                                                  p+                                                                                                                                                                                  T.aCons+                                                                                                                                                                                  (T.con12+                                                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                                                    p+                                                                                                                                                                                    T.Tuple12+                                                                                                                                                                                    T.aTuple12+                                                                                                                                                                                    fi1+                                                                                                                                                                                    fi2+                                                                                                                                                                                    fi3+                                                                                                                                                                                    fi4+                                                                                                                                                                                    fi5+                                                                                                                                                                                    fi6+                                                                                                                                                                                    fi7+                                                                                                                                                                                    fi8+                                                                                                                                                                                    fi9+                                                                                                                                                                                    fi10+                                                                                                                                                                                    fi11+                                                                                                                                                                                    fi12))+                                                                                                                                                                                f_y+                                                                                                                                                                            v0v0v0v0v1+                                                                                                                                                                              _+                                                                                                                                                                              p =+                                                                                                                                                                              T.projection+                                                                                                                                                                                T.mkNoSrcPos+                                                                                                                                                                                p+                                                                                                                                                                                f_y+                                                                                                                                                                            in+                                                                                                                                                                            (v0v0v0v0v1))+                                                                                                                                                                          f_x))+                                                                                                                                                                    (T.uap1+                                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                                      p+                                                                                                                                                                      (grange+                                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                                        p)+                                                                                                                                                                      (T.con2+                                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                                        p+                                                                                                                                                                        T.Tuple2+                                                                                                                                                                        T.aTuple2+                                                                                                                                                                        fl12+                                                                                                                                                                        fu12)))+                                                                                                                                                                  f_y+                                                                                                                                                              v0v0v0v0v1+                                                                                                                                                                _+                                                                                                                                                                p =+                                                                                                                                                                T.projection+                                                                                                                                                                  T.mkNoSrcPos+                                                                                                                                                                  p+                                                                                                                                                                  f_y+                                                                                                                                                              in+                                                                                                                                                              (v0v0v0v0v1))+                                                                                                                                                            f_x))+                                                                                                                                                      (T.uap1+                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                        p+                                                                                                                                                        (grange+                                                                                                                                                          T.mkNoSrcPos+                                                                                                                                                          p)+                                                                                                                                                        (T.con2+                                                                                                                                                          T.mkNoSrcPos+                                                                                                                                                          p+                                                                                                                                                          T.Tuple2+                                                                                                                                                          T.aTuple2+                                                                                                                                                          fl11+                                                                                                                                                          fu11)))+                                                                                                                                                    f_y+                                                                                                                                                v0v0v0v0v1+                                                                                                                                                  _+                                                                                                                                                  p =+                                                                                                                                                  T.projection+                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                    p+                                                                                                                                                    f_y+                                                                                                                                                in+                                                                                                                                                (v0v0v0v0v1))+                                                                                                                                              f_x))+                                                                                                                                        (T.uap1+                                                                                                                                          T.mkNoSrcPos+                                                                                                                                          p+                                                                                                                                          (grange+                                                                                                                                            T.mkNoSrcPos+                                                                                                                                            p)+                                                                                                                                          (T.con2+                                                                                                                                            T.mkNoSrcPos+                                                                                                                                            p+                                                                                                                                            T.Tuple2+                                                                                                                                            T.aTuple2+                                                                                                                                            fl10+                                                                                                                                            fu10)))+                                                                                                                                      f_y+                                                                                                                                  v0v0v0v0v1+                                                                                                                                    _+                                                                                                                                    p =+                                                                                                                                    T.projection+                                                                                                                                      T.mkNoSrcPos+                                                                                                                                      p+                                                                                                                                      f_y+                                                                                                                                  in+                                                                                                                                  (v0v0v0v0v1))+                                                                                                                                f_x))+                                                                                                                          (T.uap1+                                                                                                                            T.mkNoSrcPos+                                                                                                                            p+                                                                                                                            (grange+                                                                                                                              T.mkNoSrcPos+                                                                                                                              p)+                                                                                                                            (T.con2+                                                                                                                              T.mkNoSrcPos+                                                                                                                              p+                                                                                                                              T.Tuple2+                                                                                                                              T.aTuple2+                                                                                                                              fl9+                                                                                                                              fu9)))+                                                                                                                        f_y+                                                                                                                    v0v0v0v0v1+                                                                                                                      _+                                                                                                                      p =+                                                                                                                      T.projection+                                                                                                                        T.mkNoSrcPos+                                                                                                                        p+                                                                                                                        f_y+                                                                                                                    in+                                                                                                                    (v0v0v0v0v1))+                                                                                                                  f_x))+                                                                                                            (T.uap1+                                                                                                              T.mkNoSrcPos+                                                                                                              p+                                                                                                              (grange+                                                                                                                T.mkNoSrcPos+                                                                                                                p)+                                                                                                              (T.con2+                                                                                                                T.mkNoSrcPos+                                                                                                                p+                                                                                                                T.Tuple2+                                                                                                                T.aTuple2+                                                                                                                fl8+                                                                                                                fu8)))+                                                                                                          f_y+                                                                                                      v0v0v0v0v1+                                                                                                        _+                                                                                                        p =+                                                                                                        T.projection+                                                                                                          T.mkNoSrcPos+                                                                                                          p+                                                                                                          f_y+                                                                                                      in+                                                                                                      (v0v0v0v0v1))+                                                                                                    f_x))+                                                                                              (T.uap1+                                                                                                T.mkNoSrcPos+                                                                                                p+                                                                                                (grange+                                                                                                  T.mkNoSrcPos+                                                                                                  p)+                                                                                                (T.con2+                                                                                                  T.mkNoSrcPos+                                                                                                  p+                                                                                                  T.Tuple2+                                                                                                  T.aTuple2+                                                                                                  fl7+                                                                                                  fu7)))+                                                                                            f_y+                                                                                        v0v0v0v0v1+                                                                                          _+                                                                                          p =+                                                                                          T.projection+                                                                                            T.mkNoSrcPos+                                                                                            p+                                                                                            f_y+                                                                                        in+                                                                                        (v0v0v0v0v1))+                                                                                      f_x))+                                                                                (T.uap1+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  (grange+                                                                                    T.mkNoSrcPos+                                                                                    p)+                                                                                  (T.con2+                                                                                    T.mkNoSrcPos+                                                                                    p+                                                                                    T.Tuple2+                                                                                    T.aTuple2+                                                                                    fl6+                                                                                    fu6)))+                                                                              f_y+                                                                          v0v0v0v0v1+                                                                            _+                                                                            p =+                                                                            T.projection+                                                                              T.mkNoSrcPos+                                                                              p+                                                                              f_y+                                                                          in+                                                                          (v0v0v0v0v1))+                                                                        f_x))+                                                                  (T.uap1+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (grange+                                                                      T.mkNoSrcPos+                                                                      p)+                                                                    (T.con2+                                                                      T.mkNoSrcPos+                                                                      p T.Tuple2+                                                                      T.aTuple2+                                                                      fl5 fu5)))+                                                                f_y+                                                            v0v0v0v0v1 _ p =+                                                              T.projection+                                                                T.mkNoSrcPos p+                                                                f_y in+                                                            (v0v0v0v0v1)) f_x))+                                                    (T.uap1 T.mkNoSrcPos p+                                                      (grange T.mkNoSrcPos p)+                                                      (T.con2 T.mkNoSrcPos p+                                                        T.Tuple2 T.aTuple2 fl4+                                                        fu4))) f_y+                                              v0v0v0v0v1 _ p =+                                                T.projection T.mkNoSrcPos p f_y+                                              in (v0v0v0v0v1)) f_x))+                                      (T.uap1 T.mkNoSrcPos p+                                        (grange T.mkNoSrcPos p)+                                        (T.con2 T.mkNoSrcPos p T.Tuple2+                                          T.aTuple2 fl3 fu3))) f_y+                                v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y+                                in (v0v0v0v0v1)) f_x))+                        (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2)))+                      f_y+                  v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in+                  (v0v0v0v0v1)) f_x))+          (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1)))+        (T.fromExpList T.mkNoSrcPos p [])+    hrange _ p = T.fatal p+    +  +  gindex pindex p =+    T.ufun2 a366v5v380v36index pindex p hindex+    where+    +    hindex+      (T.R+        (T.Tuple2+          (T.R (T.Tuple12 fl1 fl2 fl3 fl4 fl5 fl6 fl7 fl8 fl9 fl10 fl11 fl12) _)+          (T.R (T.Tuple12 fu1 fu2 fu3 fu4 fu5 fu6 fu7 fu8 fu9 fu10 fu11 fu12)+            _)) _)+      (T.R (T.Tuple12 fi1 fi2 fi3 fi4 fi5 fi6 fi7 fi8 fi9 fi10 fi11 fi12) _) p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+        (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl12 fu12) fi12)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+          (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl12 fu12))+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+            (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl11 fu11) fi11)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+              (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl11 fu11))+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                  (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl10 fu10) fi10)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                  (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl10 fu10))+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                    (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl9 fu9) fi9)+                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                      (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                        (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl9 fu9))+                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                        (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl8 fu8)+                          fi8)+                        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                          (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl8 fu8))+                          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                            (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl7 fu7)+                              fi7)+                            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                              (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl7+                                  fu7))+                              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                                (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                                  (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl6+                                    fu6) fi6)+                                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                                  (T.uap1 T.mkNoSrcPos p+                                    (grangeSize T.mkNoSrcPos p)+                                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                      fl6 fu6))+                                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                                    (T.uap2 T.mkNoSrcPos p+                                      (gindex T.mkNoSrcPos p)+                                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                        fl5 fu5) fi5)+                                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                                      (T.uap1 T.mkNoSrcPos p+                                        (grangeSize T.mkNoSrcPos p)+                                        (T.con2 T.mkNoSrcPos p T.Tuple2+                                          T.aTuple2 fl5 fu5))+                                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                                        (T.uap2 T.mkNoSrcPos p+                                          (gindex T.mkNoSrcPos p)+                                          (T.con2 T.mkNoSrcPos p T.Tuple2+                                            T.aTuple2 fl4 fu4) fi4)+                                        (T.uap2 T.mkNoSrcPos p+                                          (T.mkNoSrcPos !* p)+                                          (T.uap1 T.mkNoSrcPos p+                                            (grangeSize T.mkNoSrcPos p)+                                            (T.con2 T.mkNoSrcPos p T.Tuple2+                                              T.aTuple2 fl4 fu4))+                                          (T.uap2 T.mkNoSrcPos p+                                            (T.mkNoSrcPos !+ p)+                                            (T.uap2 T.mkNoSrcPos p+                                              (gindex T.mkNoSrcPos p)+                                              (T.con2 T.mkNoSrcPos p T.Tuple2+                                                T.aTuple2 fl3 fu3) fi3)+                                            (T.uap2 T.mkNoSrcPos p+                                              (T.mkNoSrcPos !* p)+                                              (T.uap1 T.mkNoSrcPos p+                                                (grangeSize T.mkNoSrcPos p)+                                                (T.con2 T.mkNoSrcPos p T.Tuple2+                                                  T.aTuple2 fl3 fu3))+                                              (T.uap2 T.mkNoSrcPos p+                                                (T.mkNoSrcPos !+ p)+                                                (T.uap2 T.mkNoSrcPos p+                                                  (gindex T.mkNoSrcPos p)+                                                  (T.con2 T.mkNoSrcPos p+                                                    T.Tuple2 T.aTuple2 fl2 fu2)+                                                  fi2)+                                                (T.uap2 T.mkNoSrcPos p+                                                  (T.mkNoSrcPos !* p)+                                                  (T.uap1 T.mkNoSrcPos p+                                                    (grangeSize T.mkNoSrcPos p)+                                                    (T.con2 T.mkNoSrcPos p+                                                      T.Tuple2 T.aTuple2 fl2+                                                      fu2))+                                                  (T.uap2 T.mkNoSrcPos p+                                                    (gindex T.mkNoSrcPos p)+                                                    (T.con2 T.mkNoSrcPos p+                                                      T.Tuple2 T.aTuple2 fl1+                                                      fu1)+                                                    fi1))))))))))))))))))))))+    hindex _ _ p = T.fatal p+    +  +  ginRange pinRange p =+    T.ufun2 a382v5v396v35inRange pinRange p hinRange+    where+    +    hinRange+      (T.R+        (T.Tuple2+          (T.R (T.Tuple12 fl1 fl2 fl3 fl4 fl5 fl6 fl7 fl8 fl9 fl10 fl11 fl12) _)+          (T.R (T.Tuple12 fu1 fu2 fu3 fu4 fu5 fu6 fu7 fu8 fu9 fu10 fu11 fu12)+            _)) _)+      (T.R (T.Tuple12 fi1 fi2 fi3 fi4 fi5 fi6 fi7 fi8 fi9 fi10 fi11 fi12) _) p =+      T.uwrapForward p+        (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1) fi1)+            *&&+            (T.uwrapForward p+              (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2) fi2)+                  *&&+                  (T.uwrapForward p+                    (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3 fu3)+                          fi3)+                        *&&+                        (T.uwrapForward p+                          (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4+                                  fu4) fi4)+                              *&&+                              (T.uwrapForward p+                                (((T.uap2 T.mkNoSrcPos p+                                      (ginRange T.mkNoSrcPos p)+                                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                        fl5 fu5) fi5)+                                    *&&+                                    (T.uwrapForward p+                                      (((T.uap2 T.mkNoSrcPos p+                                            (ginRange T.mkNoSrcPos p)+                                            (T.con2 T.mkNoSrcPos p T.Tuple2+                                              T.aTuple2 fl6 fu6) fi6)+                                          *&&+                                          (T.uwrapForward p+                                            (((T.uap2 T.mkNoSrcPos p+                                                  (ginRange T.mkNoSrcPos p)+                                                  (T.con2 T.mkNoSrcPos p+                                                    T.Tuple2 T.aTuple2 fl7 fu7)+                                                  fi7)+                                                *&&+                                                (T.uwrapForward p+                                                  (((T.uap2 T.mkNoSrcPos p+                                                        (ginRange T.mkNoSrcPos+                                                          p)+                                                        (T.con2 T.mkNoSrcPos p+                                                          T.Tuple2 T.aTuple2 fl8+                                                          fu8) fi8)+                                                      *&&+                                                      (T.uwrapForward p+                                                        (((T.uap2 T.mkNoSrcPos p+                                                              (ginRange+                                                                T.mkNoSrcPos p)+                                                              (T.con2+                                                                T.mkNoSrcPos p+                                                                T.Tuple2+                                                                T.aTuple2 fl9+                                                                fu9) fi9)+                                                            *&&+                                                            (T.uwrapForward p+                                                              (((T.uap2+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (ginRange+                                                                      T.mkNoSrcPos+                                                                      p)+                                                                    (T.con2+                                                                      T.mkNoSrcPos+                                                                      p T.Tuple2+                                                                      T.aTuple2+                                                                      fl10 fu10)+                                                                    fi10)+                                                                  *&&+                                                                  (T.uwrapForward+                                                                    p+                                                                    (((T.uap2+                                                                          T.mkNoSrcPos+                                                                          p+                                                                          (ginRange+                                                                            T.mkNoSrcPos+                                                                            p)+                                                                          (T.con2+                                                                            T.mkNoSrcPos+                                                                            p+                                                                            T.Tuple2+                                                                            T.aTuple2+                                                                            fl11+                                                                            fu11)+                                                                          fi11)+                                                                        *&&+                                                                        (T.uap2+                                                                          T.mkNoSrcPos+                                                                          p+                                                                          (ginRange+                                                                            T.mkNoSrcPos+                                                                            p)+                                                                          (T.con2+                                                                            T.mkNoSrcPos+                                                                            p+                                                                            T.Tuple2+                                                                            T.aTuple2+                                                                            fl12+                                                                            fu12)+                                                                          fi12))+                                                                      p))) p)))+                                                          p))) p))) p))) p)))+                                  p))) p))) p))) p))) p)+    hinRange _ _ p = T.fatal p+    +  ++instance+  (Ix a1,Ix a2,Ix a3,Ix a4,Ix a5,Ix a6,Ix a7,Ix a8,Ix a9,Ix a10,Ix a11,Ix a12+      ,Ix a13) => Ix ((T.Tuple13 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13))+  where+  +  grange prange p =+    T.ufun1 a401v5v401v9range prange p hrange+    where+    +    hrange+      (T.R+        (T.Tuple2+          (T.R+            (T.Tuple13 fl1 fl2 fl3 fl4 fl5 fl6 fl7 fl8 fl9 fl10 fl11 fl12 fl13)+            _)+          (T.R+            (T.Tuple13 fu1 fu2 fu3 fu4 fu5 fu6 fu7 fu8 fu9 fu10 fu11 fu12 fu13)+            _)) _) p =+      T.uap1 T.mkNoSrcPos p+        (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+          (T.ufun2 T.mkLambda T.mkNoSrcPos p+            (\ f_x f_y p ->+              T.uccase T.mkNoSrcPos p+                (let+                  v0v0v0v0v1 fi1 p =+                    T.uap1 T.mkNoSrcPos p+                      (T.uap2 T.mkNoSrcPos p+                        (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                        (T.ufun2 T.mkLambda T.mkNoSrcPos p+                          (\ f_x f_y p ->+                            T.uccase T.mkNoSrcPos p+                              (let+                                v0v0v0v0v1 fi2 p =+                                  T.uap1 T.mkNoSrcPos p+                                    (T.uap2 T.mkNoSrcPos p+                                      (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                                      (T.ufun2 T.mkLambda T.mkNoSrcPos p+                                        (\ f_x f_y p ->+                                          T.uccase T.mkNoSrcPos p+                                            (let+                                              v0v0v0v0v1 fi3 p =+                                                T.uap1 T.mkNoSrcPos p+                                                  (T.uap2 T.mkNoSrcPos p+                                                    (Hat.Prelude.g_foldr+                                                      T.mkNoSrcPos p)+                                                    (T.ufun2 T.mkLambda+                                                      T.mkNoSrcPos p+                                                      (\ f_x f_y p ->+                                                        T.uccase T.mkNoSrcPos p+                                                          (let+                                                            v0v0v0v0v1 fi4 p =+                                                              T.uap1+                                                                T.mkNoSrcPos p+                                                                (T.uap2+                                                                  T.mkNoSrcPos p+                                                                  (Hat.Prelude.g_foldr+                                                                    T.mkNoSrcPos+                                                                    p)+                                                                  (T.ufun2+                                                                    T.mkLambda+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (\ f_x f_y+                                                                      p ->+                                                                      T.uccase+                                                                        T.mkNoSrcPos+                                                                        p+                                                                        (let+                                                                          v0v0v0v0v1+                                                                            fi5+                                                                            p =+                                                                            T.uap1+                                                                              T.mkNoSrcPos+                                                                              p+                                                                              (T.uap2+                                                                                T.mkNoSrcPos+                                                                                p+                                                                                (Hat.Prelude.g_foldr+                                                                                  T.mkNoSrcPos+                                                                                  p)+                                                                                (T.ufun2+                                                                                  T.mkLambda+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  (\ f_x+                                                                                    f_y+                                                                                    p ->+                                                                                    T.uccase+                                                                                      T.mkNoSrcPos+                                                                                      p+                                                                                      (let+                                                                                        v0v0v0v0v1+                                                                                          fi6+                                                                                          p =+                                                                                          T.uap1+                                                                                            T.mkNoSrcPos+                                                                                            p+                                                                                            (T.uap2+                                                                                              T.mkNoSrcPos+                                                                                              p+                                                                                              (Hat.Prelude.g_foldr+                                                                                                T.mkNoSrcPos+                                                                                                p)+                                                                                              (T.ufun2+                                                                                                T.mkLambda+                                                                                                T.mkNoSrcPos+                                                                                                p+                                                                                                (\ f_x+                                                                                                  f_y+                                                                                                  p ->+                                                                                                  T.uccase+                                                                                                    T.mkNoSrcPos+                                                                                                    p+                                                                                                    (let+                                                                                                      v0v0v0v0v1+                                                                                                        fi7+                                                                                                        p =+                                                                                                        T.uap1+                                                                                                          T.mkNoSrcPos+                                                                                                          p+                                                                                                          (T.uap2+                                                                                                            T.mkNoSrcPos+                                                                                                            p+                                                                                                            (Hat.Prelude.g_foldr+                                                                                                              T.mkNoSrcPos+                                                                                                              p)+                                                                                                            (T.ufun2+                                                                                                              T.mkLambda+                                                                                                              T.mkNoSrcPos+                                                                                                              p+                                                                                                              (\ f_x+                                                                                                                f_y+                                                                                                                p ->+                                                                                                                T.uccase+                                                                                                                  T.mkNoSrcPos+                                                                                                                  p+                                                                                                                  (let+                                                                                                                    v0v0v0v0v1+                                                                                                                      fi8+                                                                                                                      p =+                                                                                                                      T.uap1+                                                                                                                        T.mkNoSrcPos+                                                                                                                        p+                                                                                                                        (T.uap2+                                                                                                                          T.mkNoSrcPos+                                                                                                                          p+                                                                                                                          (Hat.Prelude.g_foldr+                                                                                                                            T.mkNoSrcPos+                                                                                                                            p)+                                                                                                                          (T.ufun2+                                                                                                                            T.mkLambda+                                                                                                                            T.mkNoSrcPos+                                                                                                                            p+                                                                                                                            (\ f_x+                                                                                                                              f_y+                                                                                                                              p ->+                                                                                                                              T.uccase+                                                                                                                                T.mkNoSrcPos+                                                                                                                                p+                                                                                                                                (let+                                                                                                                                  v0v0v0v0v1+                                                                                                                                    fi9+                                                                                                                                    p =+                                                                                                                                    T.uap1+                                                                                                                                      T.mkNoSrcPos+                                                                                                                                      p+                                                                                                                                      (T.uap2+                                                                                                                                        T.mkNoSrcPos+                                                                                                                                        p+                                                                                                                                        (Hat.Prelude.g_foldr+                                                                                                                                          T.mkNoSrcPos+                                                                                                                                          p)+                                                                                                                                        (T.ufun2+                                                                                                                                          T.mkLambda+                                                                                                                                          T.mkNoSrcPos+                                                                                                                                          p+                                                                                                                                          (\ f_x+                                                                                                                                            f_y+                                                                                                                                            p ->+                                                                                                                                            T.uccase+                                                                                                                                              T.mkNoSrcPos+                                                                                                                                              p+                                                                                                                                              (let+                                                                                                                                                v0v0v0v0v1+                                                                                                                                                  fi10+                                                                                                                                                  p =+                                                                                                                                                  T.uap1+                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                    p+                                                                                                                                                    (T.uap2+                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                      p+                                                                                                                                                      (Hat.Prelude.g_foldr+                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                        p)+                                                                                                                                                      (T.ufun2+                                                                                                                                                        T.mkLambda+                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                        p+                                                                                                                                                        (\ f_x+                                                                                                                                                          f_y+                                                                                                                                                          p ->+                                                                                                                                                          T.uccase+                                                                                                                                                            T.mkNoSrcPos+                                                                                                                                                            p+                                                                                                                                                            (let+                                                                                                                                                              v0v0v0v0v1+                                                                                                                                                                fi11+                                                                                                                                                                p =+                                                                                                                                                                T.uap1+                                                                                                                                                                  T.mkNoSrcPos+                                                                                                                                                                  p+                                                                                                                                                                  (T.uap2+                                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                                    p+                                                                                                                                                                    (Hat.Prelude.g_foldr+                                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                                      p)+                                                                                                                                                                    (T.ufun2+                                                                                                                                                                      T.mkLambda+                                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                                      p+                                                                                                                                                                      (\ f_x+                                                                                                                                                                        f_y+                                                                                                                                                                        p ->+                                                                                                                                                                        T.uccase+                                                                                                                                                                          T.mkNoSrcPos+                                                                                                                                                                          p+                                                                                                                                                                          (let+                                                                                                                                                                            v0v0v0v0v1+                                                                                                                                                                              fi12+                                                                                                                                                                              p =+                                                                                                                                                                              T.uap1+                                                                                                                                                                                T.mkNoSrcPos+                                                                                                                                                                                p+                                                                                                                                                                                (T.uap2+                                                                                                                                                                                  T.mkNoSrcPos+                                                                                                                                                                                  p+                                                                                                                                                                                  (Hat.Prelude.g_foldr+                                                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                                                    p)+                                                                                                                                                                                  (T.ufun2+                                                                                                                                                                                    T.mkLambda+                                                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                                                    p+                                                                                                                                                                                    (\ f_x+                                                                                                                                                                                      f_y+                                                                                                                                                                                      p ->+                                                                                                                                                                                      T.uccase+                                                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                                                        p+                                                                                                                                                                                        (let+                                                                                                                                                                                          v0v0v0v0v1+                                                                                                                                                                                            fi13+                                                                                                                                                                                            p =+                                                                                                                                                                                            T.uap1+                                                                                                                                                                                              T.mkNoSrcPos+                                                                                                                                                                                              p+                                                                                                                                                                                              (T.pa1+                                                                                                                                                                                                T.Cons+                                                                                                                                                                                                T.cn1+                                                                                                                                                                                                T.mkNoSrcPos+                                                                                                                                                                                                p+                                                                                                                                                                                                T.aCons+                                                                                                                                                                                                (T.con13+                                                                                                                                                                                                  T.mkNoSrcPos+                                                                                                                                                                                                  p+                                                                                                                                                                                                  T.Tuple13+                                                                                                                                                                                                  T.aTuple13+                                                                                                                                                                                                  fi1+                                                                                                                                                                                                  fi2+                                                                                                                                                                                                  fi3+                                                                                                                                                                                                  fi4+                                                                                                                                                                                                  fi5+                                                                                                                                                                                                  fi6+                                                                                                                                                                                                  fi7+                                                                                                                                                                                                  fi8+                                                                                                                                                                                                  fi9+                                                                                                                                                                                                  fi10+                                                                                                                                                                                                  fi11+                                                                                                                                                                                                  fi12+                                                                                                                                                                                                  fi13))+                                                                                                                                                                                              f_y+                                                                                                                                                                                          v0v0v0v0v1+                                                                                                                                                                                            _+                                                                                                                                                                                            p =+                                                                                                                                                                                            T.projection+                                                                                                                                                                                              T.mkNoSrcPos+                                                                                                                                                                                              p+                                                                                                                                                                                              f_y+                                                                                                                                                                                          in+                                                                                                                                                                                          (v0v0v0v0v1))+                                                                                                                                                                                        f_x))+                                                                                                                                                                                  (T.uap1+                                                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                                                    p+                                                                                                                                                                                    (grange+                                                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                                                      p)+                                                                                                                                                                                    (T.con2+                                                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                                                      p+                                                                                                                                                                                      T.Tuple2+                                                                                                                                                                                      T.aTuple2+                                                                                                                                                                                      fl13+                                                                                                                                                                                      fu13)))+                                                                                                                                                                                f_y+                                                                                                                                                                            v0v0v0v0v1+                                                                                                                                                                              _+                                                                                                                                                                              p =+                                                                                                                                                                              T.projection+                                                                                                                                                                                T.mkNoSrcPos+                                                                                                                                                                                p+                                                                                                                                                                                f_y+                                                                                                                                                                            in+                                                                                                                                                                            (v0v0v0v0v1))+                                                                                                                                                                          f_x))+                                                                                                                                                                    (T.uap1+                                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                                      p+                                                                                                                                                                      (grange+                                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                                        p)+                                                                                                                                                                      (T.con2+                                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                                        p+                                                                                                                                                                        T.Tuple2+                                                                                                                                                                        T.aTuple2+                                                                                                                                                                        fl12+                                                                                                                                                                        fu12)))+                                                                                                                                                                  f_y+                                                                                                                                                              v0v0v0v0v1+                                                                                                                                                                _+                                                                                                                                                                p =+                                                                                                                                                                T.projection+                                                                                                                                                                  T.mkNoSrcPos+                                                                                                                                                                  p+                                                                                                                                                                  f_y+                                                                                                                                                              in+                                                                                                                                                              (v0v0v0v0v1))+                                                                                                                                                            f_x))+                                                                                                                                                      (T.uap1+                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                        p+                                                                                                                                                        (grange+                                                                                                                                                          T.mkNoSrcPos+                                                                                                                                                          p)+                                                                                                                                                        (T.con2+                                                                                                                                                          T.mkNoSrcPos+                                                                                                                                                          p+                                                                                                                                                          T.Tuple2+                                                                                                                                                          T.aTuple2+                                                                                                                                                          fl11+                                                                                                                                                          fu11)))+                                                                                                                                                    f_y+                                                                                                                                                v0v0v0v0v1+                                                                                                                                                  _+                                                                                                                                                  p =+                                                                                                                                                  T.projection+                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                    p+                                                                                                                                                    f_y+                                                                                                                                                in+                                                                                                                                                (v0v0v0v0v1))+                                                                                                                                              f_x))+                                                                                                                                        (T.uap1+                                                                                                                                          T.mkNoSrcPos+                                                                                                                                          p+                                                                                                                                          (grange+                                                                                                                                            T.mkNoSrcPos+                                                                                                                                            p)+                                                                                                                                          (T.con2+                                                                                                                                            T.mkNoSrcPos+                                                                                                                                            p+                                                                                                                                            T.Tuple2+                                                                                                                                            T.aTuple2+                                                                                                                                            fl10+                                                                                                                                            fu10)))+                                                                                                                                      f_y+                                                                                                                                  v0v0v0v0v1+                                                                                                                                    _+                                                                                                                                    p =+                                                                                                                                    T.projection+                                                                                                                                      T.mkNoSrcPos+                                                                                                                                      p+                                                                                                                                      f_y+                                                                                                                                  in+                                                                                                                                  (v0v0v0v0v1))+                                                                                                                                f_x))+                                                                                                                          (T.uap1+                                                                                                                            T.mkNoSrcPos+                                                                                                                            p+                                                                                                                            (grange+                                                                                                                              T.mkNoSrcPos+                                                                                                                              p)+                                                                                                                            (T.con2+                                                                                                                              T.mkNoSrcPos+                                                                                                                              p+                                                                                                                              T.Tuple2+                                                                                                                              T.aTuple2+                                                                                                                              fl9+                                                                                                                              fu9)))+                                                                                                                        f_y+                                                                                                                    v0v0v0v0v1+                                                                                                                      _+                                                                                                                      p =+                                                                                                                      T.projection+                                                                                                                        T.mkNoSrcPos+                                                                                                                        p+                                                                                                                        f_y+                                                                                                                    in+                                                                                                                    (v0v0v0v0v1))+                                                                                                                  f_x))+                                                                                                            (T.uap1+                                                                                                              T.mkNoSrcPos+                                                                                                              p+                                                                                                              (grange+                                                                                                                T.mkNoSrcPos+                                                                                                                p)+                                                                                                              (T.con2+                                                                                                                T.mkNoSrcPos+                                                                                                                p+                                                                                                                T.Tuple2+                                                                                                                T.aTuple2+                                                                                                                fl8+                                                                                                                fu8)))+                                                                                                          f_y+                                                                                                      v0v0v0v0v1+                                                                                                        _+                                                                                                        p =+                                                                                                        T.projection+                                                                                                          T.mkNoSrcPos+                                                                                                          p+                                                                                                          f_y+                                                                                                      in+                                                                                                      (v0v0v0v0v1))+                                                                                                    f_x))+                                                                                              (T.uap1+                                                                                                T.mkNoSrcPos+                                                                                                p+                                                                                                (grange+                                                                                                  T.mkNoSrcPos+                                                                                                  p)+                                                                                                (T.con2+                                                                                                  T.mkNoSrcPos+                                                                                                  p+                                                                                                  T.Tuple2+                                                                                                  T.aTuple2+                                                                                                  fl7+                                                                                                  fu7)))+                                                                                            f_y+                                                                                        v0v0v0v0v1+                                                                                          _+                                                                                          p =+                                                                                          T.projection+                                                                                            T.mkNoSrcPos+                                                                                            p+                                                                                            f_y+                                                                                        in+                                                                                        (v0v0v0v0v1))+                                                                                      f_x))+                                                                                (T.uap1+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  (grange+                                                                                    T.mkNoSrcPos+                                                                                    p)+                                                                                  (T.con2+                                                                                    T.mkNoSrcPos+                                                                                    p+                                                                                    T.Tuple2+                                                                                    T.aTuple2+                                                                                    fl6+                                                                                    fu6)))+                                                                              f_y+                                                                          v0v0v0v0v1+                                                                            _+                                                                            p =+                                                                            T.projection+                                                                              T.mkNoSrcPos+                                                                              p+                                                                              f_y+                                                                          in+                                                                          (v0v0v0v0v1))+                                                                        f_x))+                                                                  (T.uap1+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (grange+                                                                      T.mkNoSrcPos+                                                                      p)+                                                                    (T.con2+                                                                      T.mkNoSrcPos+                                                                      p T.Tuple2+                                                                      T.aTuple2+                                                                      fl5 fu5)))+                                                                f_y+                                                            v0v0v0v0v1 _ p =+                                                              T.projection+                                                                T.mkNoSrcPos p+                                                                f_y in+                                                            (v0v0v0v0v1)) f_x))+                                                    (T.uap1 T.mkNoSrcPos p+                                                      (grange T.mkNoSrcPos p)+                                                      (T.con2 T.mkNoSrcPos p+                                                        T.Tuple2 T.aTuple2 fl4+                                                        fu4))) f_y+                                              v0v0v0v0v1 _ p =+                                                T.projection T.mkNoSrcPos p f_y+                                              in (v0v0v0v0v1)) f_x))+                                      (T.uap1 T.mkNoSrcPos p+                                        (grange T.mkNoSrcPos p)+                                        (T.con2 T.mkNoSrcPos p T.Tuple2+                                          T.aTuple2 fl3 fu3))) f_y+                                v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y+                                in (v0v0v0v0v1)) f_x))+                        (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2)))+                      f_y+                  v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in+                  (v0v0v0v0v1)) f_x))+          (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1)))+        (T.fromExpList T.mkNoSrcPos p [])+    hrange _ p = T.fatal p+    +  +  gindex pindex p =+    T.ufun2 a418v5v433v36index pindex p hindex+    where+    +    hindex+      (T.R+        (T.Tuple2+          (T.R+            (T.Tuple13 fl1 fl2 fl3 fl4 fl5 fl6 fl7 fl8 fl9 fl10 fl11 fl12 fl13)+            _)+          (T.R+            (T.Tuple13 fu1 fu2 fu3 fu4 fu5 fu6 fu7 fu8 fu9 fu10 fu11 fu12 fu13)+            _)) _)+      (T.R (T.Tuple13 fi1 fi2 fi3 fi4 fi5 fi6 fi7 fi8 fi9 fi10 fi11 fi12 fi13)+        _) p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+        (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl13 fu13) fi13)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+          (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl13 fu13))+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+            (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl12 fu12) fi12)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+              (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl12 fu12))+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                  (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl11 fu11) fi11)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                  (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl11 fu11))+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                    (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl10 fu10) fi10)+                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                      (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                        (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl10 fu10))+                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                        (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl9 fu9)+                          fi9)+                        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                          (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl9 fu9))+                          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                            (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl8 fu8)+                              fi8)+                            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                              (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl8+                                  fu8))+                              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                                (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                                  (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl7+                                    fu7) fi7)+                                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                                  (T.uap1 T.mkNoSrcPos p+                                    (grangeSize T.mkNoSrcPos p)+                                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                      fl7 fu7))+                                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                                    (T.uap2 T.mkNoSrcPos p+                                      (gindex T.mkNoSrcPos p)+                                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                        fl6 fu6) fi6)+                                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                                      (T.uap1 T.mkNoSrcPos p+                                        (grangeSize T.mkNoSrcPos p)+                                        (T.con2 T.mkNoSrcPos p T.Tuple2+                                          T.aTuple2 fl6 fu6))+                                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                                        (T.uap2 T.mkNoSrcPos p+                                          (gindex T.mkNoSrcPos p)+                                          (T.con2 T.mkNoSrcPos p T.Tuple2+                                            T.aTuple2 fl5 fu5) fi5)+                                        (T.uap2 T.mkNoSrcPos p+                                          (T.mkNoSrcPos !* p)+                                          (T.uap1 T.mkNoSrcPos p+                                            (grangeSize T.mkNoSrcPos p)+                                            (T.con2 T.mkNoSrcPos p T.Tuple2+                                              T.aTuple2 fl5 fu5))+                                          (T.uap2 T.mkNoSrcPos p+                                            (T.mkNoSrcPos !+ p)+                                            (T.uap2 T.mkNoSrcPos p+                                              (gindex T.mkNoSrcPos p)+                                              (T.con2 T.mkNoSrcPos p T.Tuple2+                                                T.aTuple2 fl4 fu4) fi4)+                                            (T.uap2 T.mkNoSrcPos p+                                              (T.mkNoSrcPos !* p)+                                              (T.uap1 T.mkNoSrcPos p+                                                (grangeSize T.mkNoSrcPos p)+                                                (T.con2 T.mkNoSrcPos p T.Tuple2+                                                  T.aTuple2 fl4 fu4))+                                              (T.uap2 T.mkNoSrcPos p+                                                (T.mkNoSrcPos !+ p)+                                                (T.uap2 T.mkNoSrcPos p+                                                  (gindex T.mkNoSrcPos p)+                                                  (T.con2 T.mkNoSrcPos p+                                                    T.Tuple2 T.aTuple2 fl3 fu3)+                                                  fi3)+                                                (T.uap2 T.mkNoSrcPos p+                                                  (T.mkNoSrcPos !* p)+                                                  (T.uap1 T.mkNoSrcPos p+                                                    (grangeSize T.mkNoSrcPos p)+                                                    (T.con2 T.mkNoSrcPos p+                                                      T.Tuple2 T.aTuple2 fl3+                                                      fu3))+                                                  (T.uap2 T.mkNoSrcPos p+                                                    (T.mkNoSrcPos !+ p)+                                                    (T.uap2 T.mkNoSrcPos p+                                                      (gindex T.mkNoSrcPos p)+                                                      (T.con2 T.mkNoSrcPos p+                                                        T.Tuple2 T.aTuple2 fl2+                                                        fu2) fi2)+                                                    (T.uap2 T.mkNoSrcPos p+                                                      (T.mkNoSrcPos !* p)+                                                      (T.uap1 T.mkNoSrcPos p+                                                        (grangeSize T.mkNoSrcPos+                                                          p)+                                                        (T.con2 T.mkNoSrcPos p+                                                          T.Tuple2 T.aTuple2 fl2+                                                          fu2))+                                                      (T.uap2 T.mkNoSrcPos p+                                                        (gindex T.mkNoSrcPos p)+                                                        (T.con2 T.mkNoSrcPos p+                                                          T.Tuple2 T.aTuple2 fl1+                                                          fu1)+                                                        fi1))))))))))))))))))))))))+    hindex _ _ p = T.fatal p+    +  +  ginRange pinRange p =+    T.ufun2 a435v5v450v35inRange pinRange p hinRange+    where+    +    hinRange+      (T.R+        (T.Tuple2+          (T.R+            (T.Tuple13 fl1 fl2 fl3 fl4 fl5 fl6 fl7 fl8 fl9 fl10 fl11 fl12 fl13)+            _)+          (T.R+            (T.Tuple13 fu1 fu2 fu3 fu4 fu5 fu6 fu7 fu8 fu9 fu10 fu11 fu12 fu13)+            _)) _)+      (T.R (T.Tuple13 fi1 fi2 fi3 fi4 fi5 fi6 fi7 fi8 fi9 fi10 fi11 fi12 fi13)+        _) p =+      T.uwrapForward p+        (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1) fi1)+            *&&+            (T.uwrapForward p+              (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2) fi2)+                  *&&+                  (T.uwrapForward p+                    (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3 fu3)+                          fi3)+                        *&&+                        (T.uwrapForward p+                          (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4+                                  fu4) fi4)+                              *&&+                              (T.uwrapForward p+                                (((T.uap2 T.mkNoSrcPos p+                                      (ginRange T.mkNoSrcPos p)+                                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                        fl5 fu5) fi5)+                                    *&&+                                    (T.uwrapForward p+                                      (((T.uap2 T.mkNoSrcPos p+                                            (ginRange T.mkNoSrcPos p)+                                            (T.con2 T.mkNoSrcPos p T.Tuple2+                                              T.aTuple2 fl6 fu6) fi6)+                                          *&&+                                          (T.uwrapForward p+                                            (((T.uap2 T.mkNoSrcPos p+                                                  (ginRange T.mkNoSrcPos p)+                                                  (T.con2 T.mkNoSrcPos p+                                                    T.Tuple2 T.aTuple2 fl7 fu7)+                                                  fi7)+                                                *&&+                                                (T.uwrapForward p+                                                  (((T.uap2 T.mkNoSrcPos p+                                                        (ginRange T.mkNoSrcPos+                                                          p)+                                                        (T.con2 T.mkNoSrcPos p+                                                          T.Tuple2 T.aTuple2 fl8+                                                          fu8) fi8)+                                                      *&&+                                                      (T.uwrapForward p+                                                        (((T.uap2 T.mkNoSrcPos p+                                                              (ginRange+                                                                T.mkNoSrcPos p)+                                                              (T.con2+                                                                T.mkNoSrcPos p+                                                                T.Tuple2+                                                                T.aTuple2 fl9+                                                                fu9) fi9)+                                                            *&&+                                                            (T.uwrapForward p+                                                              (((T.uap2+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (ginRange+                                                                      T.mkNoSrcPos+                                                                      p)+                                                                    (T.con2+                                                                      T.mkNoSrcPos+                                                                      p T.Tuple2+                                                                      T.aTuple2+                                                                      fl10 fu10)+                                                                    fi10)+                                                                  *&&+                                                                  (T.uwrapForward+                                                                    p+                                                                    (((T.uap2+                                                                          T.mkNoSrcPos+                                                                          p+                                                                          (ginRange+                                                                            T.mkNoSrcPos+                                                                            p)+                                                                          (T.con2+                                                                            T.mkNoSrcPos+                                                                            p+                                                                            T.Tuple2+                                                                            T.aTuple2+                                                                            fl11+                                                                            fu11)+                                                                          fi11)+                                                                        *&&+                                                                        (T.uwrapForward+                                                                          p+                                                                          (((T.uap2+                                                                                T.mkNoSrcPos+                                                                                p+                                                                                (ginRange+                                                                                  T.mkNoSrcPos+                                                                                  p)+                                                                                (T.con2+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  T.Tuple2+                                                                                  T.aTuple2+                                                                                  fl12+                                                                                  fu12)+                                                                                fi12)+                                                                              *&&+                                                                              (T.uap2+                                                                                T.mkNoSrcPos+                                                                                p+                                                                                (ginRange+                                                                                  T.mkNoSrcPos+                                                                                  p)+                                                                                (T.con2+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  T.Tuple2+                                                                                  T.aTuple2+                                                                                  fl13+                                                                                  fu13)+                                                                                fi13))+                                                                            p)))+                                                                      p))) p)))+                                                          p))) p))) p))) p)))+                                  p))) p))) p))) p))) p)+    hinRange _ _ p = T.fatal p+    +  ++instance+  (Ix a1,Ix a2,Ix a3,Ix a4,Ix a5,Ix a6,Ix a7,Ix a8,Ix a9,Ix a10,Ix a11,Ix a12+      ,Ix a13,Ix a14) =>+    Ix ((T.Tuple14 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14))+  where+  +  grange prange p =+    T.ufun1 a455v5v455v9range prange p hrange+    where+    +    hrange+      (T.R+        (T.Tuple2+          (T.R+            (T.Tuple14 fl1 fl2 fl3 fl4 fl5 fl6 fl7 fl8 fl9 fl10 fl11 fl12 fl13+              fl14) _)+          (T.R+            (T.Tuple14 fu1 fu2 fu3 fu4 fu5 fu6 fu7 fu8 fu9 fu10 fu11 fu12 fu13+              fu14) _)) _) p =+      T.uap1 T.mkNoSrcPos p+        (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+          (T.ufun2 T.mkLambda T.mkNoSrcPos p+            (\ f_x f_y p ->+              T.uccase T.mkNoSrcPos p+                (let+                  v0v0v0v0v1 fi1 p =+                    T.uap1 T.mkNoSrcPos p+                      (T.uap2 T.mkNoSrcPos p+                        (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                        (T.ufun2 T.mkLambda T.mkNoSrcPos p+                          (\ f_x f_y p ->+                            T.uccase T.mkNoSrcPos p+                              (let+                                v0v0v0v0v1 fi2 p =+                                  T.uap1 T.mkNoSrcPos p+                                    (T.uap2 T.mkNoSrcPos p+                                      (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                                      (T.ufun2 T.mkLambda T.mkNoSrcPos p+                                        (\ f_x f_y p ->+                                          T.uccase T.mkNoSrcPos p+                                            (let+                                              v0v0v0v0v1 fi3 p =+                                                T.uap1 T.mkNoSrcPos p+                                                  (T.uap2 T.mkNoSrcPos p+                                                    (Hat.Prelude.g_foldr+                                                      T.mkNoSrcPos p)+                                                    (T.ufun2 T.mkLambda+                                                      T.mkNoSrcPos p+                                                      (\ f_x f_y p ->+                                                        T.uccase T.mkNoSrcPos p+                                                          (let+                                                            v0v0v0v0v1 fi4 p =+                                                              T.uap1+                                                                T.mkNoSrcPos p+                                                                (T.uap2+                                                                  T.mkNoSrcPos p+                                                                  (Hat.Prelude.g_foldr+                                                                    T.mkNoSrcPos+                                                                    p)+                                                                  (T.ufun2+                                                                    T.mkLambda+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (\ f_x f_y+                                                                      p ->+                                                                      T.uccase+                                                                        T.mkNoSrcPos+                                                                        p+                                                                        (let+                                                                          v0v0v0v0v1+                                                                            fi5+                                                                            p =+                                                                            T.uap1+                                                                              T.mkNoSrcPos+                                                                              p+                                                                              (T.uap2+                                                                                T.mkNoSrcPos+                                                                                p+                                                                                (Hat.Prelude.g_foldr+                                                                                  T.mkNoSrcPos+                                                                                  p)+                                                                                (T.ufun2+                                                                                  T.mkLambda+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  (\ f_x+                                                                                    f_y+                                                                                    p ->+                                                                                    T.uccase+                                                                                      T.mkNoSrcPos+                                                                                      p+                                                                                      (let+                                                                                        v0v0v0v0v1+                                                                                          fi6+                                                                                          p =+                                                                                          T.uap1+                                                                                            T.mkNoSrcPos+                                                                                            p+                                                                                            (T.uap2+                                                                                              T.mkNoSrcPos+                                                                                              p+                                                                                              (Hat.Prelude.g_foldr+                                                                                                T.mkNoSrcPos+                                                                                                p)+                                                                                              (T.ufun2+                                                                                                T.mkLambda+                                                                                                T.mkNoSrcPos+                                                                                                p+                                                                                                (\ f_x+                                                                                                  f_y+                                                                                                  p ->+                                                                                                  T.uccase+                                                                                                    T.mkNoSrcPos+                                                                                                    p+                                                                                                    (let+                                                                                                      v0v0v0v0v1+                                                                                                        fi7+                                                                                                        p =+                                                                                                        T.uap1+                                                                                                          T.mkNoSrcPos+                                                                                                          p+                                                                                                          (T.uap2+                                                                                                            T.mkNoSrcPos+                                                                                                            p+                                                                                                            (Hat.Prelude.g_foldr+                                                                                                              T.mkNoSrcPos+                                                                                                              p)+                                                                                                            (T.ufun2+                                                                                                              T.mkLambda+                                                                                                              T.mkNoSrcPos+                                                                                                              p+                                                                                                              (\ f_x+                                                                                                                f_y+                                                                                                                p ->+                                                                                                                T.uccase+                                                                                                                  T.mkNoSrcPos+                                                                                                                  p+                                                                                                                  (let+                                                                                                                    v0v0v0v0v1+                                                                                                                      fi8+                                                                                                                      p =+                                                                                                                      T.uap1+                                                                                                                        T.mkNoSrcPos+                                                                                                                        p+                                                                                                                        (T.uap2+                                                                                                                          T.mkNoSrcPos+                                                                                                                          p+                                                                                                                          (Hat.Prelude.g_foldr+                                                                                                                            T.mkNoSrcPos+                                                                                                                            p)+                                                                                                                          (T.ufun2+                                                                                                                            T.mkLambda+                                                                                                                            T.mkNoSrcPos+                                                                                                                            p+                                                                                                                            (\ f_x+                                                                                                                              f_y+                                                                                                                              p ->+                                                                                                                              T.uccase+                                                                                                                                T.mkNoSrcPos+                                                                                                                                p+                                                                                                                                (let+                                                                                                                                  v0v0v0v0v1+                                                                                                                                    fi9+                                                                                                                                    p =+                                                                                                                                    T.uap1+                                                                                                                                      T.mkNoSrcPos+                                                                                                                                      p+                                                                                                                                      (T.uap2+                                                                                                                                        T.mkNoSrcPos+                                                                                                                                        p+                                                                                                                                        (Hat.Prelude.g_foldr+                                                                                                                                          T.mkNoSrcPos+                                                                                                                                          p)+                                                                                                                                        (T.ufun2+                                                                                                                                          T.mkLambda+                                                                                                                                          T.mkNoSrcPos+                                                                                                                                          p+                                                                                                                                          (\ f_x+                                                                                                                                            f_y+                                                                                                                                            p ->+                                                                                                                                            T.uccase+                                                                                                                                              T.mkNoSrcPos+                                                                                                                                              p+                                                                                                                                              (let+                                                                                                                                                v0v0v0v0v1+                                                                                                                                                  fi10+                                                                                                                                                  p =+                                                                                                                                                  T.uap1+                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                    p+                                                                                                                                                    (T.uap2+                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                      p+                                                                                                                                                      (Hat.Prelude.g_foldr+                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                        p)+                                                                                                                                                      (T.ufun2+                                                                                                                                                        T.mkLambda+                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                        p+                                                                                                                                                        (\ f_x+                                                                                                                                                          f_y+                                                                                                                                                          p ->+                                                                                                                                                          T.uccase+                                                                                                                                                            T.mkNoSrcPos+                                                                                                                                                            p+                                                                                                                                                            (let+                                                                                                                                                              v0v0v0v0v1+                                                                                                                                                                fi11+                                                                                                                                                                p =+                                                                                                                                                                T.uap1+                                                                                                                                                                  T.mkNoSrcPos+                                                                                                                                                                  p+                                                                                                                                                                  (T.uap2+                                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                                    p+                                                                                                                                                                    (Hat.Prelude.g_foldr+                                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                                      p)+                                                                                                                                                                    (T.ufun2+                                                                                                                                                                      T.mkLambda+                                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                                      p+                                                                                                                                                                      (\ f_x+                                                                                                                                                                        f_y+                                                                                                                                                                        p ->+                                                                                                                                                                        T.uccase+                                                                                                                                                                          T.mkNoSrcPos+                                                                                                                                                                          p+                                                                                                                                                                          (let+                                                                                                                                                                            v0v0v0v0v1+                                                                                                                                                                              fi12+                                                                                                                                                                              p =+                                                                                                                                                                              T.uap1+                                                                                                                                                                                T.mkNoSrcPos+                                                                                                                                                                                p+                                                                                                                                                                                (T.uap2+                                                                                                                                                                                  T.mkNoSrcPos+                                                                                                                                                                                  p+                                                                                                                                                                                  (Hat.Prelude.g_foldr+                                                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                                                    p)+                                                                                                                                                                                  (T.ufun2+                                                                                                                                                                                    T.mkLambda+                                                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                                                    p+                                                                                                                                                                                    (\ f_x+                                                                                                                                                                                      f_y+                                                                                                                                                                                      p ->+                                                                                                                                                                                      T.uccase+                                                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                                                        p+                                                                                                                                                                                        (let+                                                                                                                                                                                          v0v0v0v0v1+                                                                                                                                                                                            fi13+                                                                                                                                                                                            p =+                                                                                                                                                                                            T.uap1+                                                                                                                                                                                              T.mkNoSrcPos+                                                                                                                                                                                              p+                                                                                                                                                                                              (T.uap2+                                                                                                                                                                                                T.mkNoSrcPos+                                                                                                                                                                                                p+                                                                                                                                                                                                (Hat.Prelude.g_foldr+                                                                                                                                                                                                  T.mkNoSrcPos+                                                                                                                                                                                                  p)+                                                                                                                                                                                                (T.ufun2+                                                                                                                                                                                                  T.mkLambda+                                                                                                                                                                                                  T.mkNoSrcPos+                                                                                                                                                                                                  p+                                                                                                                                                                                                  (\ f_x+                                                                                                                                                                                                    f_y+                                                                                                                                                                                                    p ->+                                                                                                                                                                                                    T.uccase+                                                                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                                                                      p+                                                                                                                                                                                                      (let+                                                                                                                                                                                                        v0v0v0v0v1+                                                                                                                                                                                                          fi14+                                                                                                                                                                                                          p =+                                                                                                                                                                                                          T.uap1+                                                                                                                                                                                                            T.mkNoSrcPos+                                                                                                                                                                                                            p+                                                                                                                                                                                                            (T.pa1+                                                                                                                                                                                                              T.Cons+                                                                                                                                                                                                              T.cn1+                                                                                                                                                                                                              T.mkNoSrcPos+                                                                                                                                                                                                              p+                                                                                                                                                                                                              T.aCons+                                                                                                                                                                                                              (T.con14+                                                                                                                                                                                                                T.mkNoSrcPos+                                                                                                                                                                                                                p+                                                                                                                                                                                                                T.Tuple14+                                                                                                                                                                                                                T.aTuple14+                                                                                                                                                                                                                fi1+                                                                                                                                                                                                                fi2+                                                                                                                                                                                                                fi3+                                                                                                                                                                                                                fi4+                                                                                                                                                                                                                fi5+                                                                                                                                                                                                                fi6+                                                                                                                                                                                                                fi7+                                                                                                                                                                                                                fi8+                                                                                                                                                                                                                fi9+                                                                                                                                                                                                                fi10+                                                                                                                                                                                                                fi11+                                                                                                                                                                                                                fi12+                                                                                                                                                                                                                fi13+                                                                                                                                                                                                                fi14))+                                                                                                                                                                                                            f_y+                                                                                                                                                                                                        v0v0v0v0v1+                                                                                                                                                                                                          _+                                                                                                                                                                                                          p =+                                                                                                                                                                                                          T.projection+                                                                                                                                                                                                            T.mkNoSrcPos+                                                                                                                                                                                                            p+                                                                                                                                                                                                            f_y+                                                                                                                                                                                                        in+                                                                                                                                                                                                        (v0v0v0v0v1))+                                                                                                                                                                                                      f_x))+                                                                                                                                                                                                (T.uap1+                                                                                                                                                                                                  T.mkNoSrcPos+                                                                                                                                                                                                  p+                                                                                                                                                                                                  (grange+                                                                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                                                                    p)+                                                                                                                                                                                                  (T.con2+                                                                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                                                                    p+                                                                                                                                                                                                    T.Tuple2+                                                                                                                                                                                                    T.aTuple2+                                                                                                                                                                                                    fl14+                                                                                                                                                                                                    fu14)))+                                                                                                                                                                                              f_y+                                                                                                                                                                                          v0v0v0v0v1+                                                                                                                                                                                            _+                                                                                                                                                                                            p =+                                                                                                                                                                                            T.projection+                                                                                                                                                                                              T.mkNoSrcPos+                                                                                                                                                                                              p+                                                                                                                                                                                              f_y+                                                                                                                                                                                          in+                                                                                                                                                                                          (v0v0v0v0v1))+                                                                                                                                                                                        f_x))+                                                                                                                                                                                  (T.uap1+                                                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                                                    p+                                                                                                                                                                                    (grange+                                                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                                                      p)+                                                                                                                                                                                    (T.con2+                                                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                                                      p+                                                                                                                                                                                      T.Tuple2+                                                                                                                                                                                      T.aTuple2+                                                                                                                                                                                      fl13+                                                                                                                                                                                      fu13)))+                                                                                                                                                                                f_y+                                                                                                                                                                            v0v0v0v0v1+                                                                                                                                                                              _+                                                                                                                                                                              p =+                                                                                                                                                                              T.projection+                                                                                                                                                                                T.mkNoSrcPos+                                                                                                                                                                                p+                                                                                                                                                                                f_y+                                                                                                                                                                            in+                                                                                                                                                                            (v0v0v0v0v1))+                                                                                                                                                                          f_x))+                                                                                                                                                                    (T.uap1+                                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                                      p+                                                                                                                                                                      (grange+                                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                                        p)+                                                                                                                                                                      (T.con2+                                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                                        p+                                                                                                                                                                        T.Tuple2+                                                                                                                                                                        T.aTuple2+                                                                                                                                                                        fl12+                                                                                                                                                                        fu12)))+                                                                                                                                                                  f_y+                                                                                                                                                              v0v0v0v0v1+                                                                                                                                                                _+                                                                                                                                                                p =+                                                                                                                                                                T.projection+                                                                                                                                                                  T.mkNoSrcPos+                                                                                                                                                                  p+                                                                                                                                                                  f_y+                                                                                                                                                              in+                                                                                                                                                              (v0v0v0v0v1))+                                                                                                                                                            f_x))+                                                                                                                                                      (T.uap1+                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                        p+                                                                                                                                                        (grange+                                                                                                                                                          T.mkNoSrcPos+                                                                                                                                                          p)+                                                                                                                                                        (T.con2+                                                                                                                                                          T.mkNoSrcPos+                                                                                                                                                          p+                                                                                                                                                          T.Tuple2+                                                                                                                                                          T.aTuple2+                                                                                                                                                          fl11+                                                                                                                                                          fu11)))+                                                                                                                                                    f_y+                                                                                                                                                v0v0v0v0v1+                                                                                                                                                  _+                                                                                                                                                  p =+                                                                                                                                                  T.projection+                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                    p+                                                                                                                                                    f_y+                                                                                                                                                in+                                                                                                                                                (v0v0v0v0v1))+                                                                                                                                              f_x))+                                                                                                                                        (T.uap1+                                                                                                                                          T.mkNoSrcPos+                                                                                                                                          p+                                                                                                                                          (grange+                                                                                                                                            T.mkNoSrcPos+                                                                                                                                            p)+                                                                                                                                          (T.con2+                                                                                                                                            T.mkNoSrcPos+                                                                                                                                            p+                                                                                                                                            T.Tuple2+                                                                                                                                            T.aTuple2+                                                                                                                                            fl10+                                                                                                                                            fu10)))+                                                                                                                                      f_y+                                                                                                                                  v0v0v0v0v1+                                                                                                                                    _+                                                                                                                                    p =+                                                                                                                                    T.projection+                                                                                                                                      T.mkNoSrcPos+                                                                                                                                      p+                                                                                                                                      f_y+                                                                                                                                  in+                                                                                                                                  (v0v0v0v0v1))+                                                                                                                                f_x))+                                                                                                                          (T.uap1+                                                                                                                            T.mkNoSrcPos+                                                                                                                            p+                                                                                                                            (grange+                                                                                                                              T.mkNoSrcPos+                                                                                                                              p)+                                                                                                                            (T.con2+                                                                                                                              T.mkNoSrcPos+                                                                                                                              p+                                                                                                                              T.Tuple2+                                                                                                                              T.aTuple2+                                                                                                                              fl9+                                                                                                                              fu9)))+                                                                                                                        f_y+                                                                                                                    v0v0v0v0v1+                                                                                                                      _+                                                                                                                      p =+                                                                                                                      T.projection+                                                                                                                        T.mkNoSrcPos+                                                                                                                        p+                                                                                                                        f_y+                                                                                                                    in+                                                                                                                    (v0v0v0v0v1))+                                                                                                                  f_x))+                                                                                                            (T.uap1+                                                                                                              T.mkNoSrcPos+                                                                                                              p+                                                                                                              (grange+                                                                                                                T.mkNoSrcPos+                                                                                                                p)+                                                                                                              (T.con2+                                                                                                                T.mkNoSrcPos+                                                                                                                p+                                                                                                                T.Tuple2+                                                                                                                T.aTuple2+                                                                                                                fl8+                                                                                                                fu8)))+                                                                                                          f_y+                                                                                                      v0v0v0v0v1+                                                                                                        _+                                                                                                        p =+                                                                                                        T.projection+                                                                                                          T.mkNoSrcPos+                                                                                                          p+                                                                                                          f_y+                                                                                                      in+                                                                                                      (v0v0v0v0v1))+                                                                                                    f_x))+                                                                                              (T.uap1+                                                                                                T.mkNoSrcPos+                                                                                                p+                                                                                                (grange+                                                                                                  T.mkNoSrcPos+                                                                                                  p)+                                                                                                (T.con2+                                                                                                  T.mkNoSrcPos+                                                                                                  p+                                                                                                  T.Tuple2+                                                                                                  T.aTuple2+                                                                                                  fl7+                                                                                                  fu7)))+                                                                                            f_y+                                                                                        v0v0v0v0v1+                                                                                          _+                                                                                          p =+                                                                                          T.projection+                                                                                            T.mkNoSrcPos+                                                                                            p+                                                                                            f_y+                                                                                        in+                                                                                        (v0v0v0v0v1))+                                                                                      f_x))+                                                                                (T.uap1+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  (grange+                                                                                    T.mkNoSrcPos+                                                                                    p)+                                                                                  (T.con2+                                                                                    T.mkNoSrcPos+                                                                                    p+                                                                                    T.Tuple2+                                                                                    T.aTuple2+                                                                                    fl6+                                                                                    fu6)))+                                                                              f_y+                                                                          v0v0v0v0v1+                                                                            _+                                                                            p =+                                                                            T.projection+                                                                              T.mkNoSrcPos+                                                                              p+                                                                              f_y+                                                                          in+                                                                          (v0v0v0v0v1))+                                                                        f_x))+                                                                  (T.uap1+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (grange+                                                                      T.mkNoSrcPos+                                                                      p)+                                                                    (T.con2+                                                                      T.mkNoSrcPos+                                                                      p T.Tuple2+                                                                      T.aTuple2+                                                                      fl5 fu5)))+                                                                f_y+                                                            v0v0v0v0v1 _ p =+                                                              T.projection+                                                                T.mkNoSrcPos p+                                                                f_y in+                                                            (v0v0v0v0v1)) f_x))+                                                    (T.uap1 T.mkNoSrcPos p+                                                      (grange T.mkNoSrcPos p)+                                                      (T.con2 T.mkNoSrcPos p+                                                        T.Tuple2 T.aTuple2 fl4+                                                        fu4))) f_y+                                              v0v0v0v0v1 _ p =+                                                T.projection T.mkNoSrcPos p f_y+                                              in (v0v0v0v0v1)) f_x))+                                      (T.uap1 T.mkNoSrcPos p+                                        (grange T.mkNoSrcPos p)+                                        (T.con2 T.mkNoSrcPos p T.Tuple2+                                          T.aTuple2 fl3 fu3))) f_y+                                v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y+                                in (v0v0v0v0v1)) f_x))+                        (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2)))+                      f_y+                  v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in+                  (v0v0v0v0v1)) f_x))+          (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1)))+        (T.fromExpList T.mkNoSrcPos p [])+    hrange _ p = T.fatal p+    +  +  gindex pindex p =+    T.ufun2 a473v5v489v36index pindex p hindex+    where+    +    hindex+      (T.R+        (T.Tuple2+          (T.R+            (T.Tuple14 fl1 fl2 fl3 fl4 fl5 fl6 fl7 fl8 fl9 fl10 fl11 fl12 fl13+              fl14) _)+          (T.R+            (T.Tuple14 fu1 fu2 fu3 fu4 fu5 fu6 fu7 fu8 fu9 fu10 fu11 fu12 fu13+              fu14) _)) _)+      (T.R+        (T.Tuple14 fi1 fi2 fi3 fi4 fi5 fi6 fi7 fi8 fi9 fi10 fi11 fi12 fi13 fi14)+        _) p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+        (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl14 fu14) fi14)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+          (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl14 fu14))+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+            (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl13 fu13) fi13)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+              (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl13 fu13))+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                  (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl12 fu12) fi12)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                  (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl12 fu12))+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                    (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl11 fu11) fi11)+                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                      (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                        (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl11 fu11))+                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                        (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl10 fu10)+                          fi10)+                        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                          (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl10+                              fu10))+                          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                            (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl9 fu9)+                              fi9)+                            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                              (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl9+                                  fu9))+                              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                                (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                                  (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl8+                                    fu8) fi8)+                                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                                  (T.uap1 T.mkNoSrcPos p+                                    (grangeSize T.mkNoSrcPos p)+                                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                      fl8 fu8))+                                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                                    (T.uap2 T.mkNoSrcPos p+                                      (gindex T.mkNoSrcPos p)+                                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                        fl7 fu7) fi7)+                                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                                      (T.uap1 T.mkNoSrcPos p+                                        (grangeSize T.mkNoSrcPos p)+                                        (T.con2 T.mkNoSrcPos p T.Tuple2+                                          T.aTuple2 fl7 fu7))+                                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                                        (T.uap2 T.mkNoSrcPos p+                                          (gindex T.mkNoSrcPos p)+                                          (T.con2 T.mkNoSrcPos p T.Tuple2+                                            T.aTuple2 fl6 fu6) fi6)+                                        (T.uap2 T.mkNoSrcPos p+                                          (T.mkNoSrcPos !* p)+                                          (T.uap1 T.mkNoSrcPos p+                                            (grangeSize T.mkNoSrcPos p)+                                            (T.con2 T.mkNoSrcPos p T.Tuple2+                                              T.aTuple2 fl6 fu6))+                                          (T.uap2 T.mkNoSrcPos p+                                            (T.mkNoSrcPos !+ p)+                                            (T.uap2 T.mkNoSrcPos p+                                              (gindex T.mkNoSrcPos p)+                                              (T.con2 T.mkNoSrcPos p T.Tuple2+                                                T.aTuple2 fl5 fu5) fi5)+                                            (T.uap2 T.mkNoSrcPos p+                                              (T.mkNoSrcPos !* p)+                                              (T.uap1 T.mkNoSrcPos p+                                                (grangeSize T.mkNoSrcPos p)+                                                (T.con2 T.mkNoSrcPos p T.Tuple2+                                                  T.aTuple2 fl5 fu5))+                                              (T.uap2 T.mkNoSrcPos p+                                                (T.mkNoSrcPos !+ p)+                                                (T.uap2 T.mkNoSrcPos p+                                                  (gindex T.mkNoSrcPos p)+                                                  (T.con2 T.mkNoSrcPos p+                                                    T.Tuple2 T.aTuple2 fl4 fu4)+                                                  fi4)+                                                (T.uap2 T.mkNoSrcPos p+                                                  (T.mkNoSrcPos !* p)+                                                  (T.uap1 T.mkNoSrcPos p+                                                    (grangeSize T.mkNoSrcPos p)+                                                    (T.con2 T.mkNoSrcPos p+                                                      T.Tuple2 T.aTuple2 fl4+                                                      fu4))+                                                  (T.uap2 T.mkNoSrcPos p+                                                    (T.mkNoSrcPos !+ p)+                                                    (T.uap2 T.mkNoSrcPos p+                                                      (gindex T.mkNoSrcPos p)+                                                      (T.con2 T.mkNoSrcPos p+                                                        T.Tuple2 T.aTuple2 fl3+                                                        fu3) fi3)+                                                    (T.uap2 T.mkNoSrcPos p+                                                      (T.mkNoSrcPos !* p)+                                                      (T.uap1 T.mkNoSrcPos p+                                                        (grangeSize T.mkNoSrcPos+                                                          p)+                                                        (T.con2 T.mkNoSrcPos p+                                                          T.Tuple2 T.aTuple2 fl3+                                                          fu3))+                                                      (T.uap2 T.mkNoSrcPos p+                                                        (T.mkNoSrcPos !+ p)+                                                        (T.uap2 T.mkNoSrcPos p+                                                          (gindex T.mkNoSrcPos+                                                            p)+                                                          (T.con2 T.mkNoSrcPos p+                                                            T.Tuple2 T.aTuple2+                                                            fl2 fu2) fi2)+                                                        (T.uap2 T.mkNoSrcPos p+                                                          (T.mkNoSrcPos !* p)+                                                          (T.uap1 T.mkNoSrcPos p+                                                            (grangeSize+                                                              T.mkNoSrcPos p)+                                                            (T.con2 T.mkNoSrcPos+                                                              p T.Tuple2+                                                              T.aTuple2 fl2+                                                              fu2))+                                                          (T.uap2 T.mkNoSrcPos p+                                                            (gindex T.mkNoSrcPos+                                                              p)+                                                            (T.con2 T.mkNoSrcPos+                                                              p T.Tuple2+                                                              T.aTuple2 fl1 fu1)+                                                            fi1))))))))))))))))))))))))))+    hindex _ _ p = T.fatal p+    +  +  ginRange pinRange p =+    T.ufun2 a491v5v507v35inRange pinRange p hinRange+    where+    +    hinRange+      (T.R+        (T.Tuple2+          (T.R+            (T.Tuple14 fl1 fl2 fl3 fl4 fl5 fl6 fl7 fl8 fl9 fl10 fl11 fl12 fl13+              fl14) _)+          (T.R+            (T.Tuple14 fu1 fu2 fu3 fu4 fu5 fu6 fu7 fu8 fu9 fu10 fu11 fu12 fu13+              fu14) _)) _)+      (T.R+        (T.Tuple14 fi1 fi2 fi3 fi4 fi5 fi6 fi7 fi8 fi9 fi10 fi11 fi12 fi13 fi14)+        _) p =+      T.uwrapForward p+        (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1) fi1)+            *&&+            (T.uwrapForward p+              (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2) fi2)+                  *&&+                  (T.uwrapForward p+                    (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3 fu3)+                          fi3)+                        *&&+                        (T.uwrapForward p+                          (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4+                                  fu4) fi4)+                              *&&+                              (T.uwrapForward p+                                (((T.uap2 T.mkNoSrcPos p+                                      (ginRange T.mkNoSrcPos p)+                                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                        fl5 fu5) fi5)+                                    *&&+                                    (T.uwrapForward p+                                      (((T.uap2 T.mkNoSrcPos p+                                            (ginRange T.mkNoSrcPos p)+                                            (T.con2 T.mkNoSrcPos p T.Tuple2+                                              T.aTuple2 fl6 fu6) fi6)+                                          *&&+                                          (T.uwrapForward p+                                            (((T.uap2 T.mkNoSrcPos p+                                                  (ginRange T.mkNoSrcPos p)+                                                  (T.con2 T.mkNoSrcPos p+                                                    T.Tuple2 T.aTuple2 fl7 fu7)+                                                  fi7)+                                                *&&+                                                (T.uwrapForward p+                                                  (((T.uap2 T.mkNoSrcPos p+                                                        (ginRange T.mkNoSrcPos+                                                          p)+                                                        (T.con2 T.mkNoSrcPos p+                                                          T.Tuple2 T.aTuple2 fl8+                                                          fu8) fi8)+                                                      *&&+                                                      (T.uwrapForward p+                                                        (((T.uap2 T.mkNoSrcPos p+                                                              (ginRange+                                                                T.mkNoSrcPos p)+                                                              (T.con2+                                                                T.mkNoSrcPos p+                                                                T.Tuple2+                                                                T.aTuple2 fl9+                                                                fu9) fi9)+                                                            *&&+                                                            (T.uwrapForward p+                                                              (((T.uap2+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (ginRange+                                                                      T.mkNoSrcPos+                                                                      p)+                                                                    (T.con2+                                                                      T.mkNoSrcPos+                                                                      p T.Tuple2+                                                                      T.aTuple2+                                                                      fl10 fu10)+                                                                    fi10)+                                                                  *&&+                                                                  (T.uwrapForward+                                                                    p+                                                                    (((T.uap2+                                                                          T.mkNoSrcPos+                                                                          p+                                                                          (ginRange+                                                                            T.mkNoSrcPos+                                                                            p)+                                                                          (T.con2+                                                                            T.mkNoSrcPos+                                                                            p+                                                                            T.Tuple2+                                                                            T.aTuple2+                                                                            fl11+                                                                            fu11)+                                                                          fi11)+                                                                        *&&+                                                                        (T.uwrapForward+                                                                          p+                                                                          (((T.uap2+                                                                                T.mkNoSrcPos+                                                                                p+                                                                                (ginRange+                                                                                  T.mkNoSrcPos+                                                                                  p)+                                                                                (T.con2+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  T.Tuple2+                                                                                  T.aTuple2+                                                                                  fl12+                                                                                  fu12)+                                                                                fi12)+                                                                              *&&+                                                                              (T.uwrapForward+                                                                                p+                                                                                (((T.uap2+                                                                                      T.mkNoSrcPos+                                                                                      p+                                                                                      (ginRange+                                                                                        T.mkNoSrcPos+                                                                                        p)+                                                                                      (T.con2+                                                                                        T.mkNoSrcPos+                                                                                        p+                                                                                        T.Tuple2+                                                                                        T.aTuple2+                                                                                        fl13+                                                                                        fu13)+                                                                                      fi13)+                                                                                    *&&+                                                                                    (T.uap2+                                                                                      T.mkNoSrcPos+                                                                                      p+                                                                                      (ginRange+                                                                                        T.mkNoSrcPos+                                                                                        p)+                                                                                      (T.con2+                                                                                        T.mkNoSrcPos+                                                                                        p+                                                                                        T.Tuple2+                                                                                        T.aTuple2+                                                                                        fl14+                                                                                        fu14)+                                                                                      fi14))+                                                                                  p)))+                                                                            p)))+                                                                      p))) p)))+                                                          p))) p))) p))) p)))+                                  p))) p))) p))) p))) p)+    hinRange _ _ p = T.fatal p+    +  ++instance+  (Ix a1,Ix a2,Ix a3,Ix a4,Ix a5,Ix a6,Ix a7,Ix a8,Ix a9,Ix a10,Ix a11,Ix a12+      ,Ix a13,Ix a14,Ix a15) =>+    Ix ((T.Tuple15 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15))+  where+  +  grange prange p =+    T.ufun1 a512v5v512v9range prange p hrange+    where+    +    hrange+      (T.R+        (T.Tuple2+          (T.R+            (T.Tuple15 fl1 fl2 fl3 fl4 fl5 fl6 fl7 fl8 fl9 fl10 fl11 fl12 fl13+              fl14 fl15) _)+          (T.R+            (T.Tuple15 fu1 fu2 fu3 fu4 fu5 fu6 fu7 fu8 fu9 fu10 fu11 fu12 fu13+              fu14 fu15) _)) _) p =+      T.uap1 T.mkNoSrcPos p+        (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+          (T.ufun2 T.mkLambda T.mkNoSrcPos p+            (\ f_x f_y p ->+              T.uccase T.mkNoSrcPos p+                (let+                  v0v0v0v0v1 fi1 p =+                    T.uap1 T.mkNoSrcPos p+                      (T.uap2 T.mkNoSrcPos p+                        (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                        (T.ufun2 T.mkLambda T.mkNoSrcPos p+                          (\ f_x f_y p ->+                            T.uccase T.mkNoSrcPos p+                              (let+                                v0v0v0v0v1 fi2 p =+                                  T.uap1 T.mkNoSrcPos p+                                    (T.uap2 T.mkNoSrcPos p+                                      (Hat.Prelude.g_foldr T.mkNoSrcPos p)+                                      (T.ufun2 T.mkLambda T.mkNoSrcPos p+                                        (\ f_x f_y p ->+                                          T.uccase T.mkNoSrcPos p+                                            (let+                                              v0v0v0v0v1 fi3 p =+                                                T.uap1 T.mkNoSrcPos p+                                                  (T.uap2 T.mkNoSrcPos p+                                                    (Hat.Prelude.g_foldr+                                                      T.mkNoSrcPos p)+                                                    (T.ufun2 T.mkLambda+                                                      T.mkNoSrcPos p+                                                      (\ f_x f_y p ->+                                                        T.uccase T.mkNoSrcPos p+                                                          (let+                                                            v0v0v0v0v1 fi4 p =+                                                              T.uap1+                                                                T.mkNoSrcPos p+                                                                (T.uap2+                                                                  T.mkNoSrcPos p+                                                                  (Hat.Prelude.g_foldr+                                                                    T.mkNoSrcPos+                                                                    p)+                                                                  (T.ufun2+                                                                    T.mkLambda+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (\ f_x f_y+                                                                      p ->+                                                                      T.uccase+                                                                        T.mkNoSrcPos+                                                                        p+                                                                        (let+                                                                          v0v0v0v0v1+                                                                            fi5+                                                                            p =+                                                                            T.uap1+                                                                              T.mkNoSrcPos+                                                                              p+                                                                              (T.uap2+                                                                                T.mkNoSrcPos+                                                                                p+                                                                                (Hat.Prelude.g_foldr+                                                                                  T.mkNoSrcPos+                                                                                  p)+                                                                                (T.ufun2+                                                                                  T.mkLambda+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  (\ f_x+                                                                                    f_y+                                                                                    p ->+                                                                                    T.uccase+                                                                                      T.mkNoSrcPos+                                                                                      p+                                                                                      (let+                                                                                        v0v0v0v0v1+                                                                                          fi6+                                                                                          p =+                                                                                          T.uap1+                                                                                            T.mkNoSrcPos+                                                                                            p+                                                                                            (T.uap2+                                                                                              T.mkNoSrcPos+                                                                                              p+                                                                                              (Hat.Prelude.g_foldr+                                                                                                T.mkNoSrcPos+                                                                                                p)+                                                                                              (T.ufun2+                                                                                                T.mkLambda+                                                                                                T.mkNoSrcPos+                                                                                                p+                                                                                                (\ f_x+                                                                                                  f_y+                                                                                                  p ->+                                                                                                  T.uccase+                                                                                                    T.mkNoSrcPos+                                                                                                    p+                                                                                                    (let+                                                                                                      v0v0v0v0v1+                                                                                                        fi7+                                                                                                        p =+                                                                                                        T.uap1+                                                                                                          T.mkNoSrcPos+                                                                                                          p+                                                                                                          (T.uap2+                                                                                                            T.mkNoSrcPos+                                                                                                            p+                                                                                                            (Hat.Prelude.g_foldr+                                                                                                              T.mkNoSrcPos+                                                                                                              p)+                                                                                                            (T.ufun2+                                                                                                              T.mkLambda+                                                                                                              T.mkNoSrcPos+                                                                                                              p+                                                                                                              (\ f_x+                                                                                                                f_y+                                                                                                                p ->+                                                                                                                T.uccase+                                                                                                                  T.mkNoSrcPos+                                                                                                                  p+                                                                                                                  (let+                                                                                                                    v0v0v0v0v1+                                                                                                                      fi8+                                                                                                                      p =+                                                                                                                      T.uap1+                                                                                                                        T.mkNoSrcPos+                                                                                                                        p+                                                                                                                        (T.uap2+                                                                                                                          T.mkNoSrcPos+                                                                                                                          p+                                                                                                                          (Hat.Prelude.g_foldr+                                                                                                                            T.mkNoSrcPos+                                                                                                                            p)+                                                                                                                          (T.ufun2+                                                                                                                            T.mkLambda+                                                                                                                            T.mkNoSrcPos+                                                                                                                            p+                                                                                                                            (\ f_x+                                                                                                                              f_y+                                                                                                                              p ->+                                                                                                                              T.uccase+                                                                                                                                T.mkNoSrcPos+                                                                                                                                p+                                                                                                                                (let+                                                                                                                                  v0v0v0v0v1+                                                                                                                                    fi9+                                                                                                                                    p =+                                                                                                                                    T.uap1+                                                                                                                                      T.mkNoSrcPos+                                                                                                                                      p+                                                                                                                                      (T.uap2+                                                                                                                                        T.mkNoSrcPos+                                                                                                                                        p+                                                                                                                                        (Hat.Prelude.g_foldr+                                                                                                                                          T.mkNoSrcPos+                                                                                                                                          p)+                                                                                                                                        (T.ufun2+                                                                                                                                          T.mkLambda+                                                                                                                                          T.mkNoSrcPos+                                                                                                                                          p+                                                                                                                                          (\ f_x+                                                                                                                                            f_y+                                                                                                                                            p ->+                                                                                                                                            T.uccase+                                                                                                                                              T.mkNoSrcPos+                                                                                                                                              p+                                                                                                                                              (let+                                                                                                                                                v0v0v0v0v1+                                                                                                                                                  fi10+                                                                                                                                                  p =+                                                                                                                                                  T.uap1+                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                    p+                                                                                                                                                    (T.uap2+                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                      p+                                                                                                                                                      (Hat.Prelude.g_foldr+                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                        p)+                                                                                                                                                      (T.ufun2+                                                                                                                                                        T.mkLambda+                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                        p+                                                                                                                                                        (\ f_x+                                                                                                                                                          f_y+                                                                                                                                                          p ->+                                                                                                                                                          T.uccase+                                                                                                                                                            T.mkNoSrcPos+                                                                                                                                                            p+                                                                                                                                                            (let+                                                                                                                                                              v0v0v0v0v1+                                                                                                                                                                fi11+                                                                                                                                                                p =+                                                                                                                                                                T.uap1+                                                                                                                                                                  T.mkNoSrcPos+                                                                                                                                                                  p+                                                                                                                                                                  (T.uap2+                                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                                    p+                                                                                                                                                                    (Hat.Prelude.g_foldr+                                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                                      p)+                                                                                                                                                                    (T.ufun2+                                                                                                                                                                      T.mkLambda+                                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                                      p+                                                                                                                                                                      (\ f_x+                                                                                                                                                                        f_y+                                                                                                                                                                        p ->+                                                                                                                                                                        T.uccase+                                                                                                                                                                          T.mkNoSrcPos+                                                                                                                                                                          p+                                                                                                                                                                          (let+                                                                                                                                                                            v0v0v0v0v1+                                                                                                                                                                              fi12+                                                                                                                                                                              p =+                                                                                                                                                                              T.uap1+                                                                                                                                                                                T.mkNoSrcPos+                                                                                                                                                                                p+                                                                                                                                                                                (T.uap2+                                                                                                                                                                                  T.mkNoSrcPos+                                                                                                                                                                                  p+                                                                                                                                                                                  (Hat.Prelude.g_foldr+                                                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                                                    p)+                                                                                                                                                                                  (T.ufun2+                                                                                                                                                                                    T.mkLambda+                                                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                                                    p+                                                                                                                                                                                    (\ f_x+                                                                                                                                                                                      f_y+                                                                                                                                                                                      p ->+                                                                                                                                                                                      T.uccase+                                                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                                                        p+                                                                                                                                                                                        (let+                                                                                                                                                                                          v0v0v0v0v1+                                                                                                                                                                                            fi13+                                                                                                                                                                                            p =+                                                                                                                                                                                            T.uap1+                                                                                                                                                                                              T.mkNoSrcPos+                                                                                                                                                                                              p+                                                                                                                                                                                              (T.uap2+                                                                                                                                                                                                T.mkNoSrcPos+                                                                                                                                                                                                p+                                                                                                                                                                                                (Hat.Prelude.g_foldr+                                                                                                                                                                                                  T.mkNoSrcPos+                                                                                                                                                                                                  p)+                                                                                                                                                                                                (T.ufun2+                                                                                                                                                                                                  T.mkLambda+                                                                                                                                                                                                  T.mkNoSrcPos+                                                                                                                                                                                                  p+                                                                                                                                                                                                  (\ f_x+                                                                                                                                                                                                    f_y+                                                                                                                                                                                                    p ->+                                                                                                                                                                                                    T.uccase+                                                                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                                                                      p+                                                                                                                                                                                                      (let+                                                                                                                                                                                                        v0v0v0v0v1+                                                                                                                                                                                                          fi14+                                                                                                                                                                                                          p =+                                                                                                                                                                                                          T.uap1+                                                                                                                                                                                                            T.mkNoSrcPos+                                                                                                                                                                                                            p+                                                                                                                                                                                                            (T.uap2+                                                                                                                                                                                                              T.mkNoSrcPos+                                                                                                                                                                                                              p+                                                                                                                                                                                                              (Hat.Prelude.g_foldr+                                                                                                                                                                                                                T.mkNoSrcPos+                                                                                                                                                                                                                p)+                                                                                                                                                                                                              (T.ufun2+                                                                                                                                                                                                                T.mkLambda+                                                                                                                                                                                                                T.mkNoSrcPos+                                                                                                                                                                                                                p+                                                                                                                                                                                                                (\ f_x+                                                                                                                                                                                                                  f_y+                                                                                                                                                                                                                  p ->+                                                                                                                                                                                                                  T.uccase+                                                                                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                                                                                    p+                                                                                                                                                                                                                    (let+                                                                                                                                                                                                                      v0v0v0v0v1+                                                                                                                                                                                                                        fi15+                                                                                                                                                                                                                        p =+                                                                                                                                                                                                                        T.uap1+                                                                                                                                                                                                                          T.mkNoSrcPos+                                                                                                                                                                                                                          p+                                                                                                                                                                                                                          (T.pa1+                                                                                                                                                                                                                            T.Cons+                                                                                                                                                                                                                            T.cn1+                                                                                                                                                                                                                            T.mkNoSrcPos+                                                                                                                                                                                                                            p+                                                                                                                                                                                                                            T.aCons+                                                                                                                                                                                                                            (T.con15+                                                                                                                                                                                                                              T.mkNoSrcPos+                                                                                                                                                                                                                              p+                                                                                                                                                                                                                              T.Tuple15+                                                                                                                                                                                                                              T.aTuple15+                                                                                                                                                                                                                              fi1+                                                                                                                                                                                                                              fi2+                                                                                                                                                                                                                              fi3+                                                                                                                                                                                                                              fi4+                                                                                                                                                                                                                              fi5+                                                                                                                                                                                                                              fi6+                                                                                                                                                                                                                              fi7+                                                                                                                                                                                                                              fi8+                                                                                                                                                                                                                              fi9+                                                                                                                                                                                                                              fi10+                                                                                                                                                                                                                              fi11+                                                                                                                                                                                                                              fi12+                                                                                                                                                                                                                              fi13+                                                                                                                                                                                                                              fi14+                                                                                                                                                                                                                              fi15))+                                                                                                                                                                                                                          f_y+                                                                                                                                                                                                                      v0v0v0v0v1+                                                                                                                                                                                                                        _+                                                                                                                                                                                                                        p =+                                                                                                                                                                                                                        T.projection+                                                                                                                                                                                                                          T.mkNoSrcPos+                                                                                                                                                                                                                          p+                                                                                                                                                                                                                          f_y+                                                                                                                                                                                                                      in+                                                                                                                                                                                                                      (v0v0v0v0v1))+                                                                                                                                                                                                                    f_x))+                                                                                                                                                                                                              (T.uap1+                                                                                                                                                                                                                T.mkNoSrcPos+                                                                                                                                                                                                                p+                                                                                                                                                                                                                (grange+                                                                                                                                                                                                                  T.mkNoSrcPos+                                                                                                                                                                                                                  p)+                                                                                                                                                                                                                (T.con2+                                                                                                                                                                                                                  T.mkNoSrcPos+                                                                                                                                                                                                                  p+                                                                                                                                                                                                                  T.Tuple2+                                                                                                                                                                                                                  T.aTuple2+                                                                                                                                                                                                                  fl15+                                                                                                                                                                                                                  fu15)))+                                                                                                                                                                                                            f_y+                                                                                                                                                                                                        v0v0v0v0v1+                                                                                                                                                                                                          _+                                                                                                                                                                                                          p =+                                                                                                                                                                                                          T.projection+                                                                                                                                                                                                            T.mkNoSrcPos+                                                                                                                                                                                                            p+                                                                                                                                                                                                            f_y+                                                                                                                                                                                                        in+                                                                                                                                                                                                        (v0v0v0v0v1))+                                                                                                                                                                                                      f_x))+                                                                                                                                                                                                (T.uap1+                                                                                                                                                                                                  T.mkNoSrcPos+                                                                                                                                                                                                  p+                                                                                                                                                                                                  (grange+                                                                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                                                                    p)+                                                                                                                                                                                                  (T.con2+                                                                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                                                                    p+                                                                                                                                                                                                    T.Tuple2+                                                                                                                                                                                                    T.aTuple2+                                                                                                                                                                                                    fl14+                                                                                                                                                                                                    fu14)))+                                                                                                                                                                                              f_y+                                                                                                                                                                                          v0v0v0v0v1+                                                                                                                                                                                            _+                                                                                                                                                                                            p =+                                                                                                                                                                                            T.projection+                                                                                                                                                                                              T.mkNoSrcPos+                                                                                                                                                                                              p+                                                                                                                                                                                              f_y+                                                                                                                                                                                          in+                                                                                                                                                                                          (v0v0v0v0v1))+                                                                                                                                                                                        f_x))+                                                                                                                                                                                  (T.uap1+                                                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                                                    p+                                                                                                                                                                                    (grange+                                                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                                                      p)+                                                                                                                                                                                    (T.con2+                                                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                                                      p+                                                                                                                                                                                      T.Tuple2+                                                                                                                                                                                      T.aTuple2+                                                                                                                                                                                      fl13+                                                                                                                                                                                      fu13)))+                                                                                                                                                                                f_y+                                                                                                                                                                            v0v0v0v0v1+                                                                                                                                                                              _+                                                                                                                                                                              p =+                                                                                                                                                                              T.projection+                                                                                                                                                                                T.mkNoSrcPos+                                                                                                                                                                                p+                                                                                                                                                                                f_y+                                                                                                                                                                            in+                                                                                                                                                                            (v0v0v0v0v1))+                                                                                                                                                                          f_x))+                                                                                                                                                                    (T.uap1+                                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                                      p+                                                                                                                                                                      (grange+                                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                                        p)+                                                                                                                                                                      (T.con2+                                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                                        p+                                                                                                                                                                        T.Tuple2+                                                                                                                                                                        T.aTuple2+                                                                                                                                                                        fl12+                                                                                                                                                                        fu12)))+                                                                                                                                                                  f_y+                                                                                                                                                              v0v0v0v0v1+                                                                                                                                                                _+                                                                                                                                                                p =+                                                                                                                                                                T.projection+                                                                                                                                                                  T.mkNoSrcPos+                                                                                                                                                                  p+                                                                                                                                                                  f_y+                                                                                                                                                              in+                                                                                                                                                              (v0v0v0v0v1))+                                                                                                                                                            f_x))+                                                                                                                                                      (T.uap1+                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                        p+                                                                                                                                                        (grange+                                                                                                                                                          T.mkNoSrcPos+                                                                                                                                                          p)+                                                                                                                                                        (T.con2+                                                                                                                                                          T.mkNoSrcPos+                                                                                                                                                          p+                                                                                                                                                          T.Tuple2+                                                                                                                                                          T.aTuple2+                                                                                                                                                          fl11+                                                                                                                                                          fu11)))+                                                                                                                                                    f_y+                                                                                                                                                v0v0v0v0v1+                                                                                                                                                  _+                                                                                                                                                  p =+                                                                                                                                                  T.projection+                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                    p+                                                                                                                                                    f_y+                                                                                                                                                in+                                                                                                                                                (v0v0v0v0v1))+                                                                                                                                              f_x))+                                                                                                                                        (T.uap1+                                                                                                                                          T.mkNoSrcPos+                                                                                                                                          p+                                                                                                                                          (grange+                                                                                                                                            T.mkNoSrcPos+                                                                                                                                            p)+                                                                                                                                          (T.con2+                                                                                                                                            T.mkNoSrcPos+                                                                                                                                            p+                                                                                                                                            T.Tuple2+                                                                                                                                            T.aTuple2+                                                                                                                                            fl10+                                                                                                                                            fu10)))+                                                                                                                                      f_y+                                                                                                                                  v0v0v0v0v1+                                                                                                                                    _+                                                                                                                                    p =+                                                                                                                                    T.projection+                                                                                                                                      T.mkNoSrcPos+                                                                                                                                      p+                                                                                                                                      f_y+                                                                                                                                  in+                                                                                                                                  (v0v0v0v0v1))+                                                                                                                                f_x))+                                                                                                                          (T.uap1+                                                                                                                            T.mkNoSrcPos+                                                                                                                            p+                                                                                                                            (grange+                                                                                                                              T.mkNoSrcPos+                                                                                                                              p)+                                                                                                                            (T.con2+                                                                                                                              T.mkNoSrcPos+                                                                                                                              p+                                                                                                                              T.Tuple2+                                                                                                                              T.aTuple2+                                                                                                                              fl9+                                                                                                                              fu9)))+                                                                                                                        f_y+                                                                                                                    v0v0v0v0v1+                                                                                                                      _+                                                                                                                      p =+                                                                                                                      T.projection+                                                                                                                        T.mkNoSrcPos+                                                                                                                        p+                                                                                                                        f_y+                                                                                                                    in+                                                                                                                    (v0v0v0v0v1))+                                                                                                                  f_x))+                                                                                                            (T.uap1+                                                                                                              T.mkNoSrcPos+                                                                                                              p+                                                                                                              (grange+                                                                                                                T.mkNoSrcPos+                                                                                                                p)+                                                                                                              (T.con2+                                                                                                                T.mkNoSrcPos+                                                                                                                p+                                                                                                                T.Tuple2+                                                                                                                T.aTuple2+                                                                                                                fl8+                                                                                                                fu8)))+                                                                                                          f_y+                                                                                                      v0v0v0v0v1+                                                                                                        _+                                                                                                        p =+                                                                                                        T.projection+                                                                                                          T.mkNoSrcPos+                                                                                                          p+                                                                                                          f_y+                                                                                                      in+                                                                                                      (v0v0v0v0v1))+                                                                                                    f_x))+                                                                                              (T.uap1+                                                                                                T.mkNoSrcPos+                                                                                                p+                                                                                                (grange+                                                                                                  T.mkNoSrcPos+                                                                                                  p)+                                                                                                (T.con2+                                                                                                  T.mkNoSrcPos+                                                                                                  p+                                                                                                  T.Tuple2+                                                                                                  T.aTuple2+                                                                                                  fl7+                                                                                                  fu7)))+                                                                                            f_y+                                                                                        v0v0v0v0v1+                                                                                          _+                                                                                          p =+                                                                                          T.projection+                                                                                            T.mkNoSrcPos+                                                                                            p+                                                                                            f_y+                                                                                        in+                                                                                        (v0v0v0v0v1))+                                                                                      f_x))+                                                                                (T.uap1+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  (grange+                                                                                    T.mkNoSrcPos+                                                                                    p)+                                                                                  (T.con2+                                                                                    T.mkNoSrcPos+                                                                                    p+                                                                                    T.Tuple2+                                                                                    T.aTuple2+                                                                                    fl6+                                                                                    fu6)))+                                                                              f_y+                                                                          v0v0v0v0v1+                                                                            _+                                                                            p =+                                                                            T.projection+                                                                              T.mkNoSrcPos+                                                                              p+                                                                              f_y+                                                                          in+                                                                          (v0v0v0v0v1))+                                                                        f_x))+                                                                  (T.uap1+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (grange+                                                                      T.mkNoSrcPos+                                                                      p)+                                                                    (T.con2+                                                                      T.mkNoSrcPos+                                                                      p T.Tuple2+                                                                      T.aTuple2+                                                                      fl5 fu5)))+                                                                f_y+                                                            v0v0v0v0v1 _ p =+                                                              T.projection+                                                                T.mkNoSrcPos p+                                                                f_y in+                                                            (v0v0v0v0v1)) f_x))+                                                    (T.uap1 T.mkNoSrcPos p+                                                      (grange T.mkNoSrcPos p)+                                                      (T.con2 T.mkNoSrcPos p+                                                        T.Tuple2 T.aTuple2 fl4+                                                        fu4))) f_y+                                              v0v0v0v0v1 _ p =+                                                T.projection T.mkNoSrcPos p f_y+                                              in (v0v0v0v0v1)) f_x))+                                      (T.uap1 T.mkNoSrcPos p+                                        (grange T.mkNoSrcPos p)+                                        (T.con2 T.mkNoSrcPos p T.Tuple2+                                          T.aTuple2 fl3 fu3))) f_y+                                v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y+                                in (v0v0v0v0v1)) f_x))+                        (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2)))+                      f_y+                  v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in+                  (v0v0v0v0v1)) f_x))+          (T.uap1 T.mkNoSrcPos p (grange T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1)))+        (T.fromExpList T.mkNoSrcPos p [])+    hrange _ p = T.fatal p+    +  +  gindex pindex p =+    T.ufun2 a531v5v548v36index pindex p hindex+    where+    +    hindex+      (T.R+        (T.Tuple2+          (T.R+            (T.Tuple15 fl1 fl2 fl3 fl4 fl5 fl6 fl7 fl8 fl9 fl10 fl11 fl12 fl13+              fl14 fl15) _)+          (T.R+            (T.Tuple15 fu1 fu2 fu3 fu4 fu5 fu6 fu7 fu8 fu9 fu10 fu11 fu12 fu13+              fu14 fu15) _)) _)+      (T.R+        (T.Tuple15 fi1 fi2 fi3 fi4 fi5 fi6 fi7 fi8 fi9 fi10 fi11 fi12 fi13 fi14+          fi15) _) p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+        (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl15 fu15) fi15)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+          (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl15 fu15))+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+            (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl14 fu14) fi14)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+              (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl14 fu14))+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                  (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl13 fu13) fi13)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                  (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl13 fu13))+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                    (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl12 fu12) fi12)+                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                      (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                        (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl12 fu12))+                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                        (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl11 fu11)+                          fi11)+                        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                          (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl11+                              fu11))+                          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                            (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl10+                                fu10) fi10)+                            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                              (T.uap1 T.mkNoSrcPos p (grangeSize T.mkNoSrcPos p)+                                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl10+                                  fu10))+                              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                                (T.uap2 T.mkNoSrcPos p (gindex T.mkNoSrcPos p)+                                  (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl9+                                    fu9) fi9)+                                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                                  (T.uap1 T.mkNoSrcPos p+                                    (grangeSize T.mkNoSrcPos p)+                                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                      fl9 fu9))+                                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                                    (T.uap2 T.mkNoSrcPos p+                                      (gindex T.mkNoSrcPos p)+                                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                        fl8 fu8) fi8)+                                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                                      (T.uap1 T.mkNoSrcPos p+                                        (grangeSize T.mkNoSrcPos p)+                                        (T.con2 T.mkNoSrcPos p T.Tuple2+                                          T.aTuple2 fl8 fu8))+                                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                                        (T.uap2 T.mkNoSrcPos p+                                          (gindex T.mkNoSrcPos p)+                                          (T.con2 T.mkNoSrcPos p T.Tuple2+                                            T.aTuple2 fl7 fu7) fi7)+                                        (T.uap2 T.mkNoSrcPos p+                                          (T.mkNoSrcPos !* p)+                                          (T.uap1 T.mkNoSrcPos p+                                            (grangeSize T.mkNoSrcPos p)+                                            (T.con2 T.mkNoSrcPos p T.Tuple2+                                              T.aTuple2 fl7 fu7))+                                          (T.uap2 T.mkNoSrcPos p+                                            (T.mkNoSrcPos !+ p)+                                            (T.uap2 T.mkNoSrcPos p+                                              (gindex T.mkNoSrcPos p)+                                              (T.con2 T.mkNoSrcPos p T.Tuple2+                                                T.aTuple2 fl6 fu6) fi6)+                                            (T.uap2 T.mkNoSrcPos p+                                              (T.mkNoSrcPos !* p)+                                              (T.uap1 T.mkNoSrcPos p+                                                (grangeSize T.mkNoSrcPos p)+                                                (T.con2 T.mkNoSrcPos p T.Tuple2+                                                  T.aTuple2 fl6 fu6))+                                              (T.uap2 T.mkNoSrcPos p+                                                (T.mkNoSrcPos !+ p)+                                                (T.uap2 T.mkNoSrcPos p+                                                  (gindex T.mkNoSrcPos p)+                                                  (T.con2 T.mkNoSrcPos p+                                                    T.Tuple2 T.aTuple2 fl5 fu5)+                                                  fi5)+                                                (T.uap2 T.mkNoSrcPos p+                                                  (T.mkNoSrcPos !* p)+                                                  (T.uap1 T.mkNoSrcPos p+                                                    (grangeSize T.mkNoSrcPos p)+                                                    (T.con2 T.mkNoSrcPos p+                                                      T.Tuple2 T.aTuple2 fl5+                                                      fu5))+                                                  (T.uap2 T.mkNoSrcPos p+                                                    (T.mkNoSrcPos !+ p)+                                                    (T.uap2 T.mkNoSrcPos p+                                                      (gindex T.mkNoSrcPos p)+                                                      (T.con2 T.mkNoSrcPos p+                                                        T.Tuple2 T.aTuple2 fl4+                                                        fu4) fi4)+                                                    (T.uap2 T.mkNoSrcPos p+                                                      (T.mkNoSrcPos !* p)+                                                      (T.uap1 T.mkNoSrcPos p+                                                        (grangeSize T.mkNoSrcPos+                                                          p)+                                                        (T.con2 T.mkNoSrcPos p+                                                          T.Tuple2 T.aTuple2 fl4+                                                          fu4))+                                                      (T.uap2 T.mkNoSrcPos p+                                                        (T.mkNoSrcPos !+ p)+                                                        (T.uap2 T.mkNoSrcPos p+                                                          (gindex T.mkNoSrcPos+                                                            p)+                                                          (T.con2 T.mkNoSrcPos p+                                                            T.Tuple2 T.aTuple2+                                                            fl3 fu3) fi3)+                                                        (T.uap2 T.mkNoSrcPos p+                                                          (T.mkNoSrcPos !* p)+                                                          (T.uap1 T.mkNoSrcPos p+                                                            (grangeSize+                                                              T.mkNoSrcPos p)+                                                            (T.con2 T.mkNoSrcPos+                                                              p T.Tuple2+                                                              T.aTuple2 fl3+                                                              fu3))+                                                          (T.uap2 T.mkNoSrcPos p+                                                            (T.mkNoSrcPos !+ p)+                                                            (T.uap2 T.mkNoSrcPos+                                                              p+                                                              (gindex+                                                                T.mkNoSrcPos p)+                                                              (T.con2+                                                                T.mkNoSrcPos p+                                                                T.Tuple2+                                                                T.aTuple2 fl2+                                                                fu2) fi2)+                                                            (T.uap2 T.mkNoSrcPos+                                                              p+                                                              (T.mkNoSrcPos+                                                                !*+                                                                p)+                                                              (T.uap1+                                                                T.mkNoSrcPos p+                                                                (grangeSize+                                                                  T.mkNoSrcPos+                                                                  p)+                                                                (T.con2+                                                                  T.mkNoSrcPos p+                                                                  T.Tuple2+                                                                  T.aTuple2 fl2+                                                                  fu2))+                                                              (T.uap2+                                                                T.mkNoSrcPos p+                                                                (gindex+                                                                  T.mkNoSrcPos+                                                                  p)+                                                                (T.con2+                                                                  T.mkNoSrcPos p+                                                                  T.Tuple2+                                                                  T.aTuple2 fl1+                                                                  fu1)+                                                                fi1))))))))))))))))))))))))))))+    hindex _ _ p = T.fatal p+    +  +  ginRange pinRange p =+    T.ufun2 a550v5v567v35inRange pinRange p hinRange+    where+    +    hinRange+      (T.R+        (T.Tuple2+          (T.R+            (T.Tuple15 fl1 fl2 fl3 fl4 fl5 fl6 fl7 fl8 fl9 fl10 fl11 fl12 fl13+              fl14 fl15) _)+          (T.R+            (T.Tuple15 fu1 fu2 fu3 fu4 fu5 fu6 fu7 fu8 fu9 fu10 fu11 fu12 fu13+              fu14 fu15) _)) _)+      (T.R+        (T.Tuple15 fi1 fi2 fi3 fi4 fi5 fi6 fi7 fi8 fi9 fi10 fi11 fi12 fi13 fi14+          fi15) _) p =+      T.uwrapForward p+        (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl1 fu1) fi1)+            *&&+            (T.uwrapForward p+              (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl2 fu2) fi2)+                  *&&+                  (T.uwrapForward p+                    (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl3 fu3)+                          fi3)+                        *&&+                        (T.uwrapForward p+                          (((T.uap2 T.mkNoSrcPos p (ginRange T.mkNoSrcPos p)+                                (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fl4+                                  fu4) fi4)+                              *&&+                              (T.uwrapForward p+                                (((T.uap2 T.mkNoSrcPos p+                                      (ginRange T.mkNoSrcPos p)+                                      (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                                        fl5 fu5) fi5)+                                    *&&+                                    (T.uwrapForward p+                                      (((T.uap2 T.mkNoSrcPos p+                                            (ginRange T.mkNoSrcPos p)+                                            (T.con2 T.mkNoSrcPos p T.Tuple2+                                              T.aTuple2 fl6 fu6) fi6)+                                          *&&+                                          (T.uwrapForward p+                                            (((T.uap2 T.mkNoSrcPos p+                                                  (ginRange T.mkNoSrcPos p)+                                                  (T.con2 T.mkNoSrcPos p+                                                    T.Tuple2 T.aTuple2 fl7 fu7)+                                                  fi7)+                                                *&&+                                                (T.uwrapForward p+                                                  (((T.uap2 T.mkNoSrcPos p+                                                        (ginRange T.mkNoSrcPos+                                                          p)+                                                        (T.con2 T.mkNoSrcPos p+                                                          T.Tuple2 T.aTuple2 fl8+                                                          fu8) fi8)+                                                      *&&+                                                      (T.uwrapForward p+                                                        (((T.uap2 T.mkNoSrcPos p+                                                              (ginRange+                                                                T.mkNoSrcPos p)+                                                              (T.con2+                                                                T.mkNoSrcPos p+                                                                T.Tuple2+                                                                T.aTuple2 fl9+                                                                fu9) fi9)+                                                            *&&+                                                            (T.uwrapForward p+                                                              (((T.uap2+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (ginRange+                                                                      T.mkNoSrcPos+                                                                      p)+                                                                    (T.con2+                                                                      T.mkNoSrcPos+                                                                      p T.Tuple2+                                                                      T.aTuple2+                                                                      fl10 fu10)+                                                                    fi10)+                                                                  *&&+                                                                  (T.uwrapForward+                                                                    p+                                                                    (((T.uap2+                                                                          T.mkNoSrcPos+                                                                          p+                                                                          (ginRange+                                                                            T.mkNoSrcPos+                                                                            p)+                                                                          (T.con2+                                                                            T.mkNoSrcPos+                                                                            p+                                                                            T.Tuple2+                                                                            T.aTuple2+                                                                            fl11+                                                                            fu11)+                                                                          fi11)+                                                                        *&&+                                                                        (T.uwrapForward+                                                                          p+                                                                          (((T.uap2+                                                                                T.mkNoSrcPos+                                                                                p+                                                                                (ginRange+                                                                                  T.mkNoSrcPos+                                                                                  p)+                                                                                (T.con2+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  T.Tuple2+                                                                                  T.aTuple2+                                                                                  fl12+                                                                                  fu12)+                                                                                fi12)+                                                                              *&&+                                                                              (T.uwrapForward+                                                                                p+                                                                                (((T.uap2+                                                                                      T.mkNoSrcPos+                                                                                      p+                                                                                      (ginRange+                                                                                        T.mkNoSrcPos+                                                                                        p)+                                                                                      (T.con2+                                                                                        T.mkNoSrcPos+                                                                                        p+                                                                                        T.Tuple2+                                                                                        T.aTuple2+                                                                                        fl13+                                                                                        fu13)+                                                                                      fi13)+                                                                                    *&&+                                                                                    (T.uwrapForward+                                                                                      p+                                                                                      (((T.uap2+                                                                                            T.mkNoSrcPos+                                                                                            p+                                                                                            (ginRange+                                                                                              T.mkNoSrcPos+                                                                                              p)+                                                                                            (T.con2+                                                                                              T.mkNoSrcPos+                                                                                              p+                                                                                              T.Tuple2+                                                                                              T.aTuple2+                                                                                              fl14+                                                                                              fu14)+                                                                                            fi14)+                                                                                          *&&+                                                                                          (T.uap2+                                                                                            T.mkNoSrcPos+                                                                                            p+                                                                                            (ginRange+                                                                                              T.mkNoSrcPos+                                                                                              p)+                                                                                            (T.con2+                                                                                              T.mkNoSrcPos+                                                                                              p+                                                                                              T.Tuple2+                                                                                              T.aTuple2+                                                                                              fl15+                                                                                              fu15)+                                                                                            fi15))+                                                                                        p)))+                                                                                  p)))+                                                                            p)))+                                                                      p))) p)))+                                                          p))) p))) p))) p)))+                                  p))) p))) p))) p))) p)+    hinRange _ _ p = T.fatal p+    +  ++tIx = T.mkModule "Ix" "Ix.hs" Prelude.False++a9v5v10v54rangeSize =+  T.mkVariable tIx 90005 100054 3 1 "rangeSize" Prelude.False++a18v5v18v19range = T.mkVariable tIx 180005 180019 3 1 "range" Prelude.False++a19v5v21v64index = T.mkVariable tIx 190005 210064 3 2 "index" Prelude.False++a22v5v22v44inRange = T.mkVariable tIx 220005 220044 3 2 "inRange" Prelude.False++a25v5v25v19range = T.mkVariable tIx 250005 250019 3 1 "range" Prelude.False++a26v5v28v64index = T.mkVariable tIx 260005 280064 3 2 "index" Prelude.False++a29v5v29v43inRange = T.mkVariable tIx 290005 290043 3 2 "inRange" Prelude.False++a32v5v32v19range = T.mkVariable tIx 320005 320019 3 1 "range" Prelude.False++a33v5v35v64index = T.mkVariable tIx 330005 350064 3 2 "index" Prelude.False++a36v5v36v43inRange = T.mkVariable tIx 360005 360043 3 2 "inRange" Prelude.False++a39v3v39v19range = T.mkVariable tIx 390003 390019 3 1 "range" Prelude.False++a41v3v43v67index = T.mkVariable tIx 410003 430067 3 2 "index" Prelude.False++a44v3v44v44inRange = T.mkVariable tIx 440003 440044 3 2 "inRange" Prelude.False++a48v3v48v19range = T.mkVariable tIx 480003 480019 3 1 "range" Prelude.False++a50v3v52v71index = T.mkVariable tIx 500003 520071 3 2 "index" Prelude.False++a53v3v53v44inRange = T.mkVariable tIx 530003 530044 3 2 "inRange" Prelude.False++a57v3v57v25range = T.mkVariable tIx 570003 570025 3 1 "range" Prelude.False++a58v3v58v25index = T.mkVariable tIx 580003 580025 3 2 "index" Prelude.False++a59v3v59v30inRange = T.mkVariable tIx 590003 590030 3 2 "inRange" Prelude.False++a62v10v62v14range = T.mkVariable tIx 620010 620014 3 1 "range" Prelude.False++a64v10v65v72index = T.mkVariable tIx 640010 650072 3 2 "index" Prelude.False++a66v10v67v56inRange = T.mkVariable tIx 660010 670056 3 2 "inRange" Prelude.False++a70v5v70v9range = T.mkVariable tIx 700005 700009 3 1 "range" Prelude.False++a75v5v78v27index = T.mkVariable tIx 750005 780027 3 2 "index" Prelude.False++a80v5v83v32inRange = T.mkVariable tIx 800005 830032 3 2 "inRange" Prelude.False++a86v5v86v9range = T.mkVariable tIx 860005 860009 3 1 "range" Prelude.False++a92v5v96v29index = T.mkVariable tIx 920005 960029 3 2 "index" Prelude.False++a98v5v102v32inRange =+  T.mkVariable tIx 980005 1020032 3 2 "inRange" Prelude.False++a106v5v106v9range = T.mkVariable tIx 1060005 1060009 3 1 "range" Prelude.False++a113v5v118v28index = T.mkVariable tIx 1130005 1180028 3 2 "index" Prelude.False++a120v5v125v32inRange =+  T.mkVariable tIx 1200005 1250032 3 2 "inRange" Prelude.False++a129v5v129v9range = T.mkVariable tIx 1290005 1290009 3 1 "range" Prelude.False++a137v5v143v29index = T.mkVariable tIx 1370005 1430029 3 2 "index" Prelude.False++a145v5v151v32inRange =+  T.mkVariable tIx 1450005 1510032 3 2 "inRange" Prelude.False++a155v5v155v9range = T.mkVariable tIx 1550005 1550009 3 1 "range" Prelude.False++a164v5v171v29index = T.mkVariable tIx 1640005 1710029 3 2 "index" Prelude.False++a173v5v180v32inRange =+  T.mkVariable tIx 1730005 1800032 3 2 "inRange" Prelude.False++a184v5v184v9range = T.mkVariable tIx 1840005 1840009 3 1 "range" Prelude.False++a194v5v203v30index = T.mkVariable tIx 1940005 2030030 3 2 "index" Prelude.False++a205v5v214v32inRange =+  T.mkVariable tIx 2050005 2140032 3 2 "inRange" Prelude.False++a218v5v218v9range = T.mkVariable tIx 2180005 2180009 3 1 "range" Prelude.False++a230v5v240v36index = T.mkVariable tIx 2300005 2400036 3 2 "index" Prelude.False++a242v5v252v32inRange =+  T.mkVariable tIx 2420005 2520032 3 2 "inRange" Prelude.False++a257v5v257v9range = T.mkVariable tIx 2570005 2570009 3 1 "range" Prelude.False++a271v5v283v36index = T.mkVariable tIx 2710005 2830036 3 2 "index" Prelude.False++a285v5v297v35inRange =+  T.mkVariable tIx 2850005 2970035 3 2 "inRange" Prelude.False++a302v5v302v9range = T.mkVariable tIx 3020005 3020009 3 1 "range" Prelude.False++a317v5v330v36index = T.mkVariable tIx 3170005 3300036 3 2 "index" Prelude.False++a332v5v345v35inRange =+  T.mkVariable tIx 3320005 3450035 3 2 "inRange" Prelude.False++a350v5v350v9range = T.mkVariable tIx 3500005 3500009 3 1 "range" Prelude.False++a366v5v380v36index = T.mkVariable tIx 3660005 3800036 3 2 "index" Prelude.False++a382v5v396v35inRange =+  T.mkVariable tIx 3820005 3960035 3 2 "inRange" Prelude.False++a401v5v401v9range = T.mkVariable tIx 4010005 4010009 3 1 "range" Prelude.False++a418v5v433v36index = T.mkVariable tIx 4180005 4330036 3 2 "index" Prelude.False++a435v5v450v35inRange =+  T.mkVariable tIx 4350005 4500035 3 2 "inRange" Prelude.False++a455v5v455v9range = T.mkVariable tIx 4550005 4550009 3 1 "range" Prelude.False++a473v5v489v36index = T.mkVariable tIx 4730005 4890036 3 2 "index" Prelude.False++a491v5v507v35inRange =+  T.mkVariable tIx 4910005 5070035 3 2 "inRange" Prelude.False++a512v5v512v9range = T.mkVariable tIx 5120005 5120009 3 1 "range" Prelude.False++a531v5v548v36index = T.mkVariable tIx 5310005 5480036 3 2 "index" Prelude.False++a550v5v567v35inRange =+  T.mkVariable tIx 5500005 5670035 3 2 "inRange" Prelude.False
+ Hat/List.hs view
@@ -0,0 +1,1723 @@+module Hat.List+  (gelemIndex,aelemIndex,helemIndex,gelemIndices,aelemIndices,helemIndices,gfind+    ,afind,hfind,gfindIndex,afindIndex,hfindIndex,gfindIndices,afindIndices+    ,hfindIndices,gnub,gnubBy,anubBy,hnubBy,gdelete,gdeleteBy,adeleteBy+    ,hdeleteBy,(!\\),gdeleteFirstsBy,adeleteFirstsBy,hdeleteFirstsBy,gunion+    ,gunionBy,aunionBy,hunionBy,gintersect,gintersectBy,aintersectBy+    ,hintersectBy,gintersperse,aintersperse,hintersperse,gtranspose,atranspose+    ,htranspose,gpartition,apartition,hpartition,ggroup,ggroupBy,agroupBy+    ,hgroupBy,ginits,ainits,hinits,gtails,atails,htails,gisPrefixOf,aisPrefixOf+    ,hisPrefixOf,gisSuffixOf,aisSuffixOf,hisSuffixOf,gmapAccumL,amapAccumL+    ,hmapAccumL,gmapAccumR,amapAccumR,hmapAccumR,gsort,gsortBy,asortBy,hsortBy+    ,ginsert,ginsertBy,ainsertBy,hinsertBy,gmaximumBy,amaximumBy,hmaximumBy+    ,gminimumBy,aminimumBy,hminimumBy,ggenericLength,agenericLength+    ,hgenericLength,ggenericTake,agenericTake,hgenericTake,ggenericDrop+    ,agenericDrop,hgenericDrop,ggenericSplitAt,agenericSplitAt,hgenericSplitAt+    ,ggenericIndex,agenericIndex,hgenericIndex,ggenericReplicate+    ,agenericReplicate,hgenericReplicate,gzip4,gzip5,gzip6,gzip7,gzipWith4+    ,azipWith4,hzipWith4,gzipWith5,azipWith5,hzipWith5,gzipWith6,azipWith6+    ,hzipWith6,gzipWith7,azipWith7,hzipWith7,gunzip4,gunzip5,gunzip6,gunzip7+    ,gunfoldr,aunfoldr,hunfoldr,gmap,amap,hmap,(!++),(+++),(*++),gconcat,aconcat+    ,hconcat,gfilter,afilter,hfilter,ghead,ahead,hhead,glast,alast,hlast,gtail+    ,atail,htail,ginit,ainit,hinit,gnull,anull,hnull,glength,alength,hlength+    ,(!!!),(+!!),(*!!),gfoldl,afoldl,hfoldl,gfoldl1,afoldl1,hfoldl1,gscanl+    ,ascanl,hscanl,gscanl1,ascanl1,hscanl1,gfoldr,afoldr,hfoldr,gfoldr1,afoldr1+    ,hfoldr1,gscanr,ascanr,hscanr,gscanr1,ascanr1,hscanr1,giterate,aiterate+    ,hiterate,grepeat,arepeat,hrepeat,greplicate,areplicate,hreplicate,gcycle+    ,acycle,hcycle,gtake,atake,htake,gdrop,adrop,hdrop,gsplitAt,asplitAt+    ,hsplitAt,gtakeWhile,atakeWhile,htakeWhile,gdropWhile,adropWhile,hdropWhile+    ,gspan,aspan,hspan,gbreak,abreak,hbreak,glines,alines,hlines,gwords,awords+    ,hwords,gunlines,gunwords,aunwords,hunwords,greverse,gand,gor,gany,aany,hany+    ,gall,aall,hall,gelem,aelem,helem,gnotElem,anotElem,hnotElem,glookup,alookup+    ,hlookup,gsum,gproduct,gmaximum,amaximum,hmaximum,gminimum,aminimum,hminimum+    ,gconcatMap,aconcatMap,hconcatMap,gzip,gzip3,gzipWith,azipWith,hzipWith+    ,gzipWith3,azipWith3,hzipWith3,gunzip,gunzip3) where++import qualified Hat.PreludeBasic +import qualified Prelude +import Hat.Hack +import qualified Hat.Hat as T +import Hat.Hat  (WrapVal(wrapVal))+import Hat.Prelude +import Hat.Maybe  (glistToMaybe,alistToMaybe,hlistToMaybe)++gelemIndex ::+  Eq a =>+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun a (T.Fun (T.List a) (Maybe Int)))++helemIndex :: Eq a => (T.R a) -> T.RefExp -> T.R (T.Fun (T.List a) (Maybe Int))++gelemIndex pelemIndex p = T.ufun1 aelemIndex pelemIndex p helemIndex++helemIndex fx p =+  T.uwrapForward p+    (hfindIndex (T.uap1 T.mkNoSrcPos p (T.mkNoSrcPos !== p) fx) p)++gelemIndices ::+  Eq a =>+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun a (T.Fun (T.List a) (T.List Int)))++helemIndices ::+  Eq a => (T.R a) -> T.RefExp -> T.R (T.Fun (T.List a) (T.List Int))++gelemIndices pelemIndices p = T.ufun1 aelemIndices pelemIndices p helemIndices++helemIndices fx p =+  T.uap1 T.mkNoSrcPos p (gfindIndices T.mkNoSrcPos p)+    (T.uap1 T.mkNoSrcPos p (T.mkNoSrcPos !== p) fx)++gfind ::+  T.RefSrcPos ->+    T.RefExp -> T.R (T.Fun (T.Fun a Bool) (T.Fun (T.List a) (Maybe a)))++hfind :: (T.R (T.Fun a Bool)) -> T.RefExp -> T.R (T.Fun (T.List a) (Maybe a))++gfind pfind p = T.ufun1 afind pfind p hfind++hfind fp p =+  T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !. p) (glistToMaybe T.mkNoSrcPos p)+    (T.uap1 T.mkNoSrcPos p (gfilter T.mkNoSrcPos p) fp)++gfindIndex ::+  T.RefSrcPos ->+    T.RefExp -> T.R (T.Fun (T.Fun a Bool) (T.Fun (T.List a) (Maybe Int)))++hfindIndex ::+  (T.R (T.Fun a Bool)) -> T.RefExp -> T.R (T.Fun (T.List a) (Maybe Int))++gfindIndex pfindIndex p = T.ufun1 afindIndex pfindIndex p hfindIndex++hfindIndex fp p =+  T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !. p) (glistToMaybe T.mkNoSrcPos p)+    (T.uap1 T.mkNoSrcPos p (gfindIndices T.mkNoSrcPos p) fp)++gfindIndices ::+  T.RefSrcPos ->+    T.RefExp -> T.R (T.Fun (T.Fun a Bool) (T.Fun (T.List a) (T.List Int)))++hfindIndices ::+  (T.R (T.Fun a Bool)) -> (T.R (T.List a)) -> T.RefExp -> T.R (T.List Int)++gfindIndices pfindIndices p = T.ufun2 afindIndices pfindIndices p hfindIndices++hfindIndices fp fxs p =+  T.uap1 T.mkNoSrcPos p+    (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+      (T.ufun2 T.mkLambda T.mkNoSrcPos p+        (\ f_x f_y p ->+          T.uccase T.mkNoSrcPos p+            (let+              v0v0v0v0v1 (T.R (T.Tuple2 fx fi) _) p =+                T.uap1 T.mkNoSrcPos p+                  (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_filter T.mkNoSrcPos p)+                    (T.uap1 T.mkNoSrcPos p fp fx)+                    (T.pa1 T.Cons T.cn1 T.mkNoSrcPos p T.aCons fi)) f_y+              v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in (v0v0v0v0v1))+            f_x))+      (T.uap2 T.mkNoSrcPos p (gzip T.mkNoSrcPos p) fxs+        (T.uap1 T.mkNoSrcPos p (Hat.Prelude.genumFrom T.mkNoSrcPos p)+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 0)))))+    (T.fromExpList T.mkNoSrcPos p [])++gnub :: Eq a => T.RefSrcPos -> T.RefExp -> T.R (T.Fun (T.List a) (T.List a))++snub :: Eq a => T.R (T.Fun (T.List a) (T.List a))++gnub pnub p = T.uconstUse pnub p snub++snub =+  T.uconstDef T.mkRoot anub+    (\ p -> T.uap1 T.mkNoSrcPos p (gnubBy T.mkNoSrcPos p) (T.mkNoSrcPos !== p))++gnubBy ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R (T.Fun (T.Fun a (T.Fun a Bool)) (T.Fun (T.List a) (T.List a)))++hnubBy ::+  (T.R (T.Fun a (T.Fun a Bool))) ->+    (T.R (T.List a)) -> T.RefExp -> T.R (T.List a)++gnubBy pnubBy p = T.ufun2 anubBy pnubBy p hnubBy++hnubBy feq (T.R T.List _) p = T.con0 T.mkNoSrcPos p T.List T.aList+hnubBy feq (T.R (T.Cons fx fxs) _) p =+  T.con2 T.mkNoSrcPos p T.Cons T.aCons fx+    (T.uwrapForward p+      (hnubBy feq+        (T.uwrapForward p+          (hfilter+            (T.ufun1 T.mkLambda T.mkNoSrcPos p+              (\ fy p ->+                T.uwrapForward p (hnot (T.uap2 T.mkNoSrcPos p feq fx fy) p)))+            fxs p)) p))+hnubBy _ _ p = T.fatal p++gdelete ::+  Eq a => T.RefSrcPos -> T.RefExp -> T.R (T.Fun a (T.Fun (T.List a) (T.List a)))++sdelete :: Eq a => T.R (T.Fun a (T.Fun (T.List a) (T.List a)))++gdelete pdelete p = T.uconstUse pdelete p sdelete++sdelete =+  T.uconstDef T.mkRoot adelete+    (\ p ->+      T.uap1 T.mkNoSrcPos p (gdeleteBy T.mkNoSrcPos p) (T.mkNoSrcPos !== p))++gdeleteBy ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.Fun a (T.Fun a Bool)) (T.Fun a (T.Fun (T.List a) (T.List a))))++hdeleteBy ::+  (T.R (T.Fun a (T.Fun a Bool))) ->+    (T.R a) -> (T.R (T.List a)) -> T.RefExp -> T.R (T.List a)++gdeleteBy pdeleteBy p = T.ufun3 adeleteBy pdeleteBy p hdeleteBy++hdeleteBy feq fx (T.R T.List _) p = T.con0 T.mkNoSrcPos p T.List T.aList+hdeleteBy feq fx (T.R (T.Cons fy fys) _) p =+  T.ucif p (T.uap2 T.mkNoSrcPos p feq fx fy) (T.projection T.mkNoSrcPos p fys)+    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fy+      (T.uwrapForward p (hdeleteBy feq fx fys p)))+hdeleteBy _ _ _ p = T.fatal p++(!\\) ::+  Eq a =>+  T.RefSrcPos ->+    T.RefExp -> T.R (T.Fun (T.List a) (T.Fun (T.List a) (T.List a)))++(|\\) :: Eq a => T.R (T.Fun (T.List a) (T.Fun (T.List a) (T.List a)))++(!\\) (%\\) p = T.uconstUse (%\\) p (|\\)++(|\\) =+  T.uconstDef T.mkRoot (+\\)+    (\ p ->+      T.uap1 T.mkNoSrcPos p (gfoldl T.mkNoSrcPos p)+        (T.uap1 T.mkNoSrcPos p (gflip T.mkNoSrcPos p) (gdelete T.mkNoSrcPos p)))++gdeleteFirstsBy ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.Fun a (T.Fun a Bool))+          (T.Fun (T.List a) (T.Fun (T.List a) (T.List a))))++hdeleteFirstsBy ::+  (T.R (T.Fun a (T.Fun a Bool))) ->+    T.RefExp -> T.R (T.Fun (T.List a) (T.Fun (T.List a) (T.List a)))++gdeleteFirstsBy pdeleteFirstsBy p =+  T.ufun1 adeleteFirstsBy pdeleteFirstsBy p hdeleteFirstsBy++hdeleteFirstsBy feq p =+  T.uap1 T.mkNoSrcPos p (gfoldl T.mkNoSrcPos p)+    (T.uap1 T.mkNoSrcPos p (gflip T.mkNoSrcPos p)+      (T.uap1 T.mkNoSrcPos p (gdeleteBy T.mkNoSrcPos p) feq))++gunion ::+  Eq a =>+  T.RefSrcPos ->+    T.RefExp -> T.R (T.Fun (T.List a) (T.Fun (T.List a) (T.List a)))++sunion :: Eq a => T.R (T.Fun (T.List a) (T.Fun (T.List a) (T.List a)))++gunion punion p = T.uconstUse punion p sunion++sunion =+  T.uconstDef T.mkRoot aunion+    (\ p ->+      T.uap1 T.mkNoSrcPos p (gunionBy T.mkNoSrcPos p) (T.mkNoSrcPos !== p))++gunionBy ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.Fun a (T.Fun a Bool))+          (T.Fun (T.List a) (T.Fun (T.List a) (T.List a))))++hunionBy ::+  (T.R (T.Fun a (T.Fun a Bool))) ->+    (T.R (T.List a)) -> (T.R (T.List a)) -> T.RefExp -> T.R (T.List a)++gunionBy punionBy p = T.ufun3 aunionBy punionBy p hunionBy++hunionBy feq fxs fys p =+  T.uwrapForward p+    ((fxs+        *+++        (T.uap3 T.mkNoSrcPos p (gdeleteFirstsBy T.mkNoSrcPos p) feq+          (T.uwrapForward p (hnubBy feq fys p)) fxs)) p)++gintersect ::+  Eq a =>+  T.RefSrcPos ->+    T.RefExp -> T.R (T.Fun (T.List a) (T.Fun (T.List a) (T.List a)))++sintersect :: Eq a => T.R (T.Fun (T.List a) (T.Fun (T.List a) (T.List a)))++gintersect pintersect p = T.uconstUse pintersect p sintersect++sintersect =+  T.uconstDef T.mkRoot aintersect+    (\ p ->+      T.uap1 T.mkNoSrcPos p (gintersectBy T.mkNoSrcPos p) (T.mkNoSrcPos !== p))++gintersectBy ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.Fun a (T.Fun a Bool))+          (T.Fun (T.List a) (T.Fun (T.List a) (T.List a))))++hintersectBy ::+  (T.R (T.Fun a (T.Fun a Bool))) ->+    (T.R (T.List a)) -> (T.R (T.List a)) -> T.RefExp -> T.R (T.List a)++gintersectBy pintersectBy p = T.ufun3 aintersectBy pintersectBy p hintersectBy++hintersectBy feq fxs fys p =+  T.uap1 T.mkNoSrcPos p+    (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+      (T.ufun2 T.mkLambda T.mkNoSrcPos p+        (\ f_x f_y p ->+          T.uccase T.mkNoSrcPos p+            (let+              v0v0v0v0v1 fx p =+                T.uap1 T.mkNoSrcPos p+                  (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_filter T.mkNoSrcPos p)+                    (T.uap2 T.mkNoSrcPos p (gany T.mkNoSrcPos p)+                      (T.uap1 T.mkNoSrcPos p feq fx) fys)+                    (T.pa1 T.Cons T.cn1 T.mkNoSrcPos p T.aCons fx)) f_y+              v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in (v0v0v0v0v1))+            f_x)) fxs) (T.fromExpList T.mkNoSrcPos p [])++gintersperse ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun a (T.Fun (T.List a) (T.List a)))++hintersperse :: (T.R a) -> (T.R (T.List a)) -> T.RefExp -> T.R (T.List a)++gintersperse pintersperse p = T.ufun2 aintersperse pintersperse p hintersperse++hintersperse fsep (T.R T.List _) p = T.con0 T.mkNoSrcPos p T.List T.aList+hintersperse fsep (T.R (T.Cons fx (T.R T.List _)) _) p =+  T.fromExpList T.mkNoSrcPos p [fx]+hintersperse fsep (T.R (T.Cons fx fxs) _) p =+  T.con2 T.mkNoSrcPos p T.Cons T.aCons fx+    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fsep+      (T.uwrapForward p (hintersperse fsep fxs p)))+hintersperse _ _ p = T.fatal p++gtranspose ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun (T.List (T.List a)) (T.List (T.List a)))++htranspose :: (T.R (T.List (T.List a))) -> T.RefExp -> T.R (T.List (T.List a))++gtranspose ptranspose p = T.ufun1 atranspose ptranspose p htranspose++htranspose (T.R T.List _) p = T.con0 T.mkNoSrcPos p T.List T.aList+htranspose (T.R (T.Cons (T.R T.List _) fxss) _) p =+  T.uwrapForward p (htranspose fxss p)+htranspose (T.R (T.Cons (T.R (T.Cons fx fxs) _) fxss) _) p =+  T.con2 T.mkNoSrcPos p T.Cons T.aCons+    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fx+      (T.uap1 T.mkNoSrcPos p+        (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+          (T.ufun2 T.mkLambda T.mkNoSrcPos p+            (\ f_x f_y p ->+              T.uccase T.mkNoSrcPos p+                (let+                  v0v0v0v0v1 (T.R (T.Cons fh ft) _) p =+                    T.uap1 T.mkNoSrcPos p+                      (T.pa1 T.Cons T.cn1 T.mkNoSrcPos p T.aCons fh) f_y+                  v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in+                  (v0v0v0v0v1)) f_x)) fxss) (T.fromExpList T.mkNoSrcPos p [])))+    (T.uwrapForward p+      (htranspose+        (T.con2 T.mkNoSrcPos p T.Cons T.aCons fxs+          (T.uap1 T.mkNoSrcPos p+            (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+              (T.ufun2 T.mkLambda T.mkNoSrcPos p+                (\ f_x f_y p ->+                  T.uccase T.mkNoSrcPos p+                    (let+                      v0v0v0v0v1 (T.R (T.Cons fh ft) _) p =+                        T.uap1 T.mkNoSrcPos p+                          (T.pa1 T.Cons T.cn1 T.mkNoSrcPos p T.aCons ft) f_y+                      v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in+                      (v0v0v0v0v1)) f_x)) fxss)+            (T.fromExpList T.mkNoSrcPos p []))) p))+htranspose _ p = T.fatal p++gpartition ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.Fun a Bool)+          (T.Fun (T.List a) (T.Tuple2 (T.List a) (T.List a))))++hpartition ::+  (T.R (T.Fun a Bool)) ->+    (T.R (T.List a)) -> T.RefExp -> T.R (T.Tuple2 (T.List a) (T.List a))++gpartition ppartition p = T.ufun2 apartition ppartition p hpartition++hpartition fp fxs p =+  T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 (T.uwrapForward p (hfilter fp fxs p))+    (T.uwrapForward p+      (hfilter+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !. p) (gnot T.mkNoSrcPos p) fp) fxs+        p))++ggroup ::+  Eq a => T.RefSrcPos -> T.RefExp -> T.R (T.Fun (T.List a) (T.List (T.List a)))++sgroup :: Eq a => T.R (T.Fun (T.List a) (T.List (T.List a)))++ggroup pgroup p = T.uconstUse pgroup p sgroup++sgroup =+  T.uconstDef T.mkRoot agroup+    (\ p ->+      T.uap1 T.mkNoSrcPos p (ggroupBy T.mkNoSrcPos p) (T.mkNoSrcPos !== p))++ggroupBy ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.Fun a (T.Fun a Bool)) (T.Fun (T.List a) (T.List (T.List a))))++hgroupBy ::+  (T.R (T.Fun a (T.Fun a Bool))) ->+    (T.R (T.List a)) -> T.RefExp -> T.R (T.List (T.List a))++ggroupBy pgroupBy p = T.ufun2 agroupBy pgroupBy p hgroupBy++hgroupBy feq (T.R T.List _) p = T.con0 T.mkNoSrcPos p T.List T.aList+hgroupBy feq (T.R (T.Cons fx fxs) _) p =+  T.con2 T.mkNoSrcPos p T.Cons T.aCons+    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fx (gys T.mkNoSrcPos p))+    (T.uwrapForward p (hgroupBy feq (gzs T.mkNoSrcPos p) p))+  where+  +  gys pys p = T.uconstUse pys p sys+  +  gzs pys p = T.uconstUse pys p szs+  +  j108v34v108v40ys =+    case T.uwrapForward p (hspan (T.uap1 T.mkNoSrcPos p feq fx) fxs p) of+      T.R (T.Tuple2 fys fzs) kys -> (kys,fys,fzs)+      _ -> T.fatal p+  +  sys =+    T.uconstDef p a108v35v108v36ys+      (\ _ -> case j108v34v108v40ys of (kys,fys,fzs) -> fys)+  +  szs =+    T.uconstDef p a108v38v108v39zs+      (\ _ -> case j108v34v108v40ys of (kys,fys,fzs) -> fzs)+  +hgroupBy _ _ p = T.fatal p++ginits :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun (T.List a) (T.List (T.List a)))++hinits :: (T.R (T.List a)) -> T.RefExp -> T.R (T.List (T.List a))++ginits pinits p = T.ufun1 ainits pinits p hinits++hinits (T.R T.List _) p =+  T.fromExpList T.mkNoSrcPos p [T.con0 T.mkNoSrcPos p T.List T.aList]+hinits (T.R (T.Cons fx fxs) _) p =+  T.uwrapForward p+    (((T.fromExpList T.mkNoSrcPos p [T.con0 T.mkNoSrcPos p T.List T.aList])+        *+++        (T.uwrapForward p+          (hmap (T.pa1 T.Cons T.cn1 T.mkNoSrcPos p T.aCons fx)+            (T.uwrapForward p (hinits fxs p)) p))) p)+hinits _ p = T.fatal p++gtails :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun (T.List a) (T.List (T.List a)))++htails :: (T.R (T.List a)) -> T.RefExp -> T.R (T.List (T.List a))++gtails ptails p = T.ufun1 atails ptails p htails++htails (T.R T.List _) p =+  T.fromExpList T.mkNoSrcPos p [T.con0 T.mkNoSrcPos p T.List T.aList]+htails (fxxs@(T.R (T.Cons _ fxs) _)) p =+  T.con2 T.mkNoSrcPos p T.Cons T.aCons fxxs (T.uwrapForward p (htails fxs p))+htails _ p = T.fatal p++gisPrefixOf ::+  Eq a =>+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun (T.List a) (T.Fun (T.List a) Bool))++hisPrefixOf ::+  Eq a => (T.R (T.List a)) -> (T.R (T.List a)) -> T.RefExp -> T.R Bool++gisPrefixOf pisPrefixOf p = T.ufun2 aisPrefixOf pisPrefixOf p hisPrefixOf++hisPrefixOf (T.R T.List _) _ p = T.con0 T.mkNoSrcPos p True aTrue+hisPrefixOf _ (T.R T.List _) p = T.con0 T.mkNoSrcPos p False aFalse+hisPrefixOf (T.R (T.Cons fx fxs) _) (T.R (T.Cons fy fys) _) p =+  T.uwrapForward p+    (((T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !== p) fx fy)+        *&&+        (T.uwrapForward p (hisPrefixOf fxs fys p))) p)+hisPrefixOf _ _ p = T.fatal p++gisSuffixOf ::+  Eq a =>+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun (T.List a) (T.Fun (T.List a) Bool))++hisSuffixOf ::+  Eq a => (T.R (T.List a)) -> (T.R (T.List a)) -> T.RefExp -> T.R Bool++gisSuffixOf pisSuffixOf p = T.ufun2 aisSuffixOf pisSuffixOf p hisSuffixOf++hisSuffixOf fx fy p =+  T.uwrapForward p+    (hisPrefixOf (T.uap1 T.mkNoSrcPos p (greverse T.mkNoSrcPos p) fx)+      (T.uap1 T.mkNoSrcPos p (greverse T.mkNoSrcPos p) fy) p)++gmapAccumL ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.Fun a (T.Fun b (T.Tuple2 a c)))+          (T.Fun a (T.Fun (T.List b) (T.Tuple2 a (T.List c)))))++hmapAccumL ::+  (T.R (T.Fun a (T.Fun b (T.Tuple2 a c)))) ->+    (T.R a) -> (T.R (T.List b)) -> T.RefExp -> T.R (T.Tuple2 a (T.List c))++gmapAccumL pmapAccumL p = T.ufun3 amapAccumL pmapAccumL p hmapAccumL++hmapAccumL ff fs (T.R T.List _) p =+  T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fs+    (T.con0 T.mkNoSrcPos p T.List T.aList)+hmapAccumL ff fs (T.R (T.Cons fx fxs) _) p =+  T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 (gs'' T.mkNoSrcPos p)+    (T.con2 T.mkNoSrcPos p T.Cons T.aCons (gy T.mkNoSrcPos p)+      (gys T.mkNoSrcPos p))+  where+  +  gs' ps' p = T.uconstUse ps' p ss'+  +  gy ps' p = T.uconstUse ps' p sy+  +  j133v34v133v41s' =+    case T.uap2 T.mkNoSrcPos p ff fs fx of+      T.R (T.Tuple2 fs' fy) ks' -> (ks',fs',fy)+      _ -> T.fatal p+  +  ss' =+    T.uconstDef p a133v35v133v36s'+      (\ _ -> case j133v34v133v41s' of (ks',fs',fy) -> fs')+  +  sy =+    T.uconstDef p a133v39v133v39y+      (\ _ -> case j133v34v133v41s' of (ks',fs',fy) -> fy)+  +  gs'' ps'' p = T.uconstUse ps'' p ss''+  +  gys ps'' p = T.uconstUse ps'' p sys+  +  j134v34v134v41s'' =+    case T.uwrapForward p (hmapAccumL ff (gs' T.mkNoSrcPos p) fxs p) of+      T.R (T.Tuple2 fs'' fys) ks'' -> (ks'',fs'',fys)+      _ -> T.fatal p+  +  ss'' =+    T.uconstDef p a134v35v134v37s''+      (\ _ -> case j134v34v134v41s'' of (ks'',fs'',fys) -> fs'')+  +  sys =+    T.uconstDef p a134v39v134v40ys+      (\ _ -> case j134v34v134v41s'' of (ks'',fs'',fys) -> fys)+  +hmapAccumL _ _ _ p = T.fatal p++gmapAccumR ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.Fun a (T.Fun b (T.Tuple2 a c)))+          (T.Fun a (T.Fun (T.List b) (T.Tuple2 a (T.List c)))))++hmapAccumR ::+  (T.R (T.Fun a (T.Fun b (T.Tuple2 a c)))) ->+    (T.R a) -> (T.R (T.List b)) -> T.RefExp -> T.R (T.Tuple2 a (T.List c))++gmapAccumR pmapAccumR p = T.ufun3 amapAccumR pmapAccumR p hmapAccumR++hmapAccumR ff fs (T.R T.List _) p =+  T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fs+    (T.con0 T.mkNoSrcPos p T.List T.aList)+hmapAccumR ff fs (T.R (T.Cons fx fxs) _) p =+  T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 (gs'' T.mkNoSrcPos p)+    (T.con2 T.mkNoSrcPos p T.Cons T.aCons (gy T.mkNoSrcPos p)+      (gys T.mkNoSrcPos p))+  where+  +  gs'' ps'' p = T.uconstUse ps'' p ss''+  +  gy ps'' p = T.uconstUse ps'' p sy+  +  j139v34v139v41s'' =+    case T.uap2 T.mkNoSrcPos p ff (gs' T.mkNoSrcPos p) fx of+      T.R (T.Tuple2 fs'' fy) ks'' -> (ks'',fs'',fy)+      _ -> T.fatal p+  +  ss'' =+    T.uconstDef p a139v35v139v37s''+      (\ _ -> case j139v34v139v41s'' of (ks'',fs'',fy) -> fs'')+  +  sy =+    T.uconstDef p a139v39v139v39y+      (\ _ -> case j139v34v139v41s'' of (ks'',fs'',fy) -> fy)+  +  gs' ps' p = T.uconstUse ps' p ss'+  +  gys ps' p = T.uconstUse ps' p sys+  +  j140v34v140v41s' =+    case T.uwrapForward p (hmapAccumR ff fs fxs p) of+      T.R (T.Tuple2 fs' fys) ks' -> (ks',fs',fys)+      _ -> T.fatal p+  +  ss' =+    T.uconstDef p a140v35v140v36s'+      (\ _ -> case j140v34v140v41s' of (ks',fs',fys) -> fs')+  +  sys =+    T.uconstDef p a140v39v140v40ys+      (\ _ -> case j140v34v140v41s' of (ks',fs',fys) -> fys)+  +hmapAccumR _ _ _ p = T.fatal p++gunfoldr ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R (T.Fun (T.Fun b (Maybe (T.Tuple2 a b))) (T.Fun b (T.List a)))++hunfoldr ::+  (T.R (T.Fun b (Maybe (T.Tuple2 a b)))) ->+    (T.R b) -> T.RefExp -> T.R (T.List a)++gunfoldr punfoldr p = T.ufun2 aunfoldr punfoldr p hunfoldr++hunfoldr ff fb p =+  T.uccase T.mkNoSrcPos p+    (let+      v143v27v145v61v1 (T.R Nothing _) p = T.con0 T.mkNoSrcPos p T.List T.aList+      v143v27v145v61v1 (T.R (Just (T.R (T.Tuple2 fa fb) _)) _) p =+        T.con2 T.mkNoSrcPos p T.Cons T.aCons fa+          (T.uwrapForward p (hunfoldr ff fb p))+      v143v27v145v61v1 _ p = T.fatal p in (v143v27v145v61v1))+    (T.uap1 T.mkNoSrcPos p ff fb)++gsort :: Ord a => T.RefSrcPos -> T.RefExp -> T.R (T.Fun (T.List a) (T.List a))++ssort :: Ord a => T.R (T.Fun (T.List a) (T.List a))++gsort psort p = T.uconstUse psort p ssort++ssort =+  T.uconstDef T.mkRoot asort+    (\ p -> T.uwrapForward p (hsortBy (gcompare T.mkNoSrcPos p) p))++gsortBy ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R (T.Fun (T.Fun a (T.Fun a Ordering)) (T.Fun (T.List a) (T.List a)))++hsortBy ::+  (T.R (T.Fun a (T.Fun a Ordering))) ->+    T.RefExp -> T.R (T.Fun (T.List a) (T.List a))++gsortBy psortBy p = T.ufun1 asortBy psortBy p hsortBy++hsortBy fcmp p =+  T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !. p) (gmergeAll T.mkNoSrcPos p)+    (gsequences T.mkNoSrcPos p)+  where+  +  gsequences psequences p =+    T.ufun1 a153v5v156v23sequences psequences p hsequences+  +  asequences = a153v5v156v23sequences+  +  hsequences (T.R (T.Cons fa (T.R (T.Cons fb fxs) _)) _) p =+    T.ucguard+      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !== p)+        (T.uap2 T.mkNoSrcPos p fcmp fa fb) (T.con0 T.mkNoSrcPos p GT aGT))+      (T.uwrapForward p+        (hdescending fb (T.fromExpList T.mkNoSrcPos p [fa]) fxs p))+      (T.ucguard (gotherwise T.mkNoSrcPos p)+        (T.uwrapForward p+          (hascending fb (T.pa1 T.Cons T.cn1 T.mkNoSrcPos p T.aCons fa) fxs p))+        (T.fatal p))+  hsequences fxs p = T.fromExpList T.mkNoSrcPos p [fxs]+  +  gdescending pdescending p =+    T.ufun3 a158v5v160v46descending pdescending p hdescending+  +  adescending = a158v5v160v46descending+  +  hdescending fa fas (z3descending@(T.R (T.Cons fb fbs) _)) p =+    T.ucguard+      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !== p)+        (T.uap2 T.mkNoSrcPos p fcmp fa fb) (T.con0 T.mkNoSrcPos p GT aGT))+      (T.uwrapForward p+        (hdescending fb (T.con2 T.mkNoSrcPos p T.Cons T.aCons fa fas) fbs p))+      (y1descending fa fas z3descending p)+  hdescending fa fas z3descending p = y1descending fa fas z3descending p+  +  y1descending fa fas fbs p =+    T.con2 T.mkNoSrcPos p T.Cons T.aCons+      (T.con2 T.mkNoSrcPos p T.Cons T.aCons fa fas)+      (T.uwrapForward p (hsequences fbs p))+  +  gascending pascending p =+    T.ufun3 a162v5v164v46ascending pascending p hascending+  +  aascending = a162v5v164v46ascending+  +  hascending fa fas (z3ascending@(T.R (T.Cons fb fbs) _)) p =+    T.ucguard+      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !/= p)+        (T.uap2 T.mkNoSrcPos p fcmp fa fb) (T.con0 T.mkNoSrcPos p GT aGT))+      (T.uwrapForward p+        (hascending fb+          (T.ufun1 T.mkLambda T.mkNoSrcPos p+            (\ fys p ->+              T.uap1 T.mkNoSrcPos p fas+                (T.con2 T.mkNoSrcPos p T.Cons T.aCons fa fys))) fbs p))+      (y1ascending fa fas z3ascending p)+  hascending fa fas z3ascending p = y1ascending fa fas z3ascending p+  +  y1ascending fa fas fbs p =+    T.con2 T.mkNoSrcPos p T.Cons T.aCons+      (T.uap1 T.mkNoSrcPos p fas (T.fromExpList T.mkNoSrcPos p [fa]))+      (T.uwrapForward p (hsequences fbs p))+  +  gmergeAll pmergeAll p = T.ufun1 a166v5v167v42mergeAll pmergeAll p hmergeAll+  +  amergeAll = a166v5v167v42mergeAll+  +  hmergeAll (T.R (T.Cons fx (T.R T.List _)) _) p =+    T.projection T.mkNoSrcPos p fx+  hmergeAll fxs p =+    T.uwrapForward p (hmergeAll (T.uwrapForward p (hmergePairs fxs p)) p)+  +  gmergePairs pmergePairs p =+    T.ufun1 a169v5v170v28mergePairs pmergePairs p hmergePairs+  +  amergePairs = a169v5v170v28mergePairs+  +  hmergePairs (T.R (T.Cons fa (T.R (T.Cons fb fxs) _)) _) p =+    T.con2 T.mkNoSrcPos p T.Cons T.aCons (T.uwrapForward p (hmerge fa fb p))+      (T.uwrapForward p (hmergePairs fxs p))+  hmergePairs fxs p = T.projection T.mkNoSrcPos p fxs+  +  gmerge pmerge p = T.ufun2 a172v5v176v28merge pmerge p hmerge+  +  amerge = a172v5v176v28merge+  +  hmerge (fas@(T.R (T.Cons fa fas') _)) (fbs@(T.R (T.Cons fb fbs') _)) p =+    T.ucguard+      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !== p)+        (T.uap2 T.mkNoSrcPos p fcmp fa fb) (T.con0 T.mkNoSrcPos p GT aGT))+      (T.con2 T.mkNoSrcPos p T.Cons T.aCons fb+        (T.uwrapForward p (hmerge fas fbs' p)))+      (T.ucguard (gotherwise T.mkNoSrcPos p)+        (T.con2 T.mkNoSrcPos p T.Cons T.aCons fa+          (T.uwrapForward p (hmerge fas' fbs p))) (T.fatal p))+  hmerge (T.R T.List _) fbs p = T.projection T.mkNoSrcPos p fbs+  hmerge fas (T.R T.List _) p = T.projection T.mkNoSrcPos p fas+  hmerge _ _ p = T.fatal p+  ++ginsert ::+  Ord a =>+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun a (T.Fun (T.List a) (T.List a)))++sinsert :: Ord a => T.R (T.Fun a (T.Fun (T.List a) (T.List a)))++ginsert pinsert p = T.uconstUse pinsert p sinsert++sinsert =+  T.uconstDef T.mkRoot ainsert+    (\ p ->+      T.uap1 T.mkNoSrcPos p (ginsertBy T.mkNoSrcPos p)+        (gcompare T.mkNoSrcPos p))++ginsertBy ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.Fun a (T.Fun a Ordering))+          (T.Fun a (T.Fun (T.List a) (T.List a))))++hinsertBy ::+  (T.R (T.Fun a (T.Fun a Ordering))) ->+    (T.R a) -> (T.R (T.List a)) -> T.RefExp -> T.R (T.List a)++ginsertBy pinsertBy p = T.ufun3 ainsertBy pinsertBy p hinsertBy++hinsertBy fcmp fx (T.R T.List _) p = T.fromExpList T.mkNoSrcPos p [fx]+hinsertBy fcmp fx (fys@(T.R (T.Cons fy fys') _)) p =+  T.uccase T.mkNoSrcPos p+    (let+      v184v28v186v44v1 (T.R GT _) p =+        T.con2 T.mkNoSrcPos p T.Cons T.aCons fy+          (T.uwrapForward p (hinsertBy fcmp fx fys' p))+      v184v28v186v44v1 _ p = T.con2 T.mkNoSrcPos p T.Cons T.aCons fx fys in+      (v184v28v186v44v1)) (T.uap2 T.mkNoSrcPos p fcmp fx fy)+hinsertBy _ _ _ p = T.fatal p++gmaximumBy ::+  T.RefSrcPos ->+    T.RefExp -> T.R (T.Fun (T.Fun a (T.Fun a Ordering)) (T.Fun (T.List a) a))++hmaximumBy ::+  (T.R (T.Fun a (T.Fun a Ordering))) -> (T.R (T.List a)) -> T.RefExp -> T.R a++gmaximumBy pmaximumBy p = T.ufun2 amaximumBy pmaximumBy p hmaximumBy++hmaximumBy fcmp (T.R T.List _) p =+  T.uwrapForward p+    (herror (T.fromLitString T.mkNoSrcPos p "List.maximumBy: empty list") p)+hmaximumBy fcmp fxs p =+  T.uwrapForward p (hfoldl1 (gmax T.mkNoSrcPos p) fxs p)+  where+  +  gmax pmax p = T.ufun2 a192v28v194v47max pmax p hmax+  +  amax = a192v28v194v47max+  +  hmax fx fy p =+    T.uccase T.mkNoSrcPos p+      (let+        v192v38v194v47v1 (T.R GT _) p = T.projection T.mkNoSrcPos p fx+        v192v38v194v47v1 _ p = T.projection T.mkNoSrcPos p fy in+        (v192v38v194v47v1)) (T.uap2 T.mkNoSrcPos p fcmp fx fy)+  ++gminimumBy ::+  T.RefSrcPos ->+    T.RefExp -> T.R (T.Fun (T.Fun a (T.Fun a Ordering)) (T.Fun (T.List a) a))++hminimumBy ::+  (T.R (T.Fun a (T.Fun a Ordering))) -> (T.R (T.List a)) -> T.RefExp -> T.R a++gminimumBy pminimumBy p = T.ufun2 aminimumBy pminimumBy p hminimumBy++hminimumBy fcmp (T.R T.List _) p =+  T.uwrapForward p+    (herror (T.fromLitString T.mkNoSrcPos p "List.minimumBy: empty list") p)+hminimumBy fcmp fxs p =+  T.uwrapForward p (hfoldl1 (gmin T.mkNoSrcPos p) fxs p)+  where+  +  gmin pmin p = T.ufun2 a200v28v202v47min pmin p hmin+  +  amin = a200v28v202v47min+  +  hmin fx fy p =+    T.uccase T.mkNoSrcPos p+      (let+        v200v38v202v47v1 (T.R GT _) p = T.projection T.mkNoSrcPos p fy+        v200v38v202v47v1 _ p = T.projection T.mkNoSrcPos p fx in+        (v200v38v202v47v1)) (T.uap2 T.mkNoSrcPos p fcmp fx fy)+  ++ggenericLength ::+  Integral a => T.RefSrcPos -> T.RefExp -> T.R (T.Fun (T.List b) a)++hgenericLength :: Integral a => (T.R (T.List b)) -> T.RefExp -> T.R a++ggenericLength pgenericLength p =+  T.ufun1 agenericLength pgenericLength p hgenericLength++hgenericLength (T.R T.List _) p =+  T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+    (T.conInteger T.mkNoSrcPos p 0)+hgenericLength (T.R (T.Cons fx fxs) _) p =+  T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+    (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+      (T.conInteger T.mkNoSrcPos p 1)) (T.uwrapForward p (hgenericLength fxs p))+hgenericLength _ p = T.fatal p++ggenericTake ::+  Integral a =>+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun a (T.Fun (T.List b) (T.List b)))++hgenericTake ::+  Integral a => (T.R a) -> (T.R (T.List b)) -> T.RefExp -> T.R (T.List b)++ggenericTake pgenericTake p = T.ufun2 agenericTake pgenericTake p hgenericTake++hgenericTake _ (T.R T.List _) p = T.con0 T.mkNoSrcPos p T.List T.aList+hgenericTake fv210v13v210v13n v210v15v210v15n p =+  T.ucguard+    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv210v13v210v13n+      (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 0))) (h v210v15v210v15n p)+    (y1genericTake fv210v13v210v13n v210v15v210v15n p)+  where+  +  h _ p = T.con0 T.mkNoSrcPos p T.List T.aList+  h _ p = y1genericTake fv210v13v210v13n v210v15v210v15n p+  +hgenericTake fv210v13v210v13n v210v15v210v15n p =+  y1genericTake fv210v13v210v13n v210v15v210v15n p++y1genericTake fn (T.R (T.Cons fx fxs) _) p =+  T.ucguard+    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !> p) fn+      (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 0)))+    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fx+      (T.uwrapForward p+        (hgenericTake+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !- p) fn+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 1))) fxs p)))+    (T.ucguard (gotherwise T.mkNoSrcPos p)+      (T.uwrapForward p+        (herror+          (T.fromLitString T.mkNoSrcPos p "List.genericTake: negative argument")+          p)) (T.fatal p))+y1genericTake _ _ p = T.fatal p++ggenericDrop ::+  Integral a =>+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun a (T.Fun (T.List b) (T.List b)))++hgenericDrop ::+  Integral a => (T.R a) -> (T.R (T.List b)) -> T.RefExp -> T.R (T.List b)++ggenericDrop pgenericDrop p = T.ufun2 agenericDrop pgenericDrop p hgenericDrop++hgenericDrop fv216v13v216v13n fxs p =+  T.ucguard+    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv216v13v216v13n+      (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 0))) (h fxs p)+    (y1genericDrop fv216v13v216v13n fxs p)+  where+  +  h fxs p = T.projection T.mkNoSrcPos p fxs+  h _ p = y1genericDrop fv216v13v216v13n fxs p+  +hgenericDrop fv216v13v216v13n fxs p = y1genericDrop fv216v13v216v13n fxs p++y1genericDrop _ (T.R T.List _) p = T.con0 T.mkNoSrcPos p T.List T.aList+y1genericDrop fn (T.R (T.Cons _ fxs) _) p =+  T.ucguard+    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !> p) fn+      (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 0)))+    (T.uwrapForward p+      (hgenericDrop+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !- p) fn+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 1))) fxs p))+    (T.ucguard (gotherwise T.mkNoSrcPos p)+      (T.uwrapForward p+        (herror+          (T.fromLitString T.mkNoSrcPos p "List.genericDrop: negative argument")+          p)) (T.fatal p))+y1genericDrop _ _ p = T.fatal p++ggenericSplitAt ::+  Integral a =>+  T.RefSrcPos ->+    T.RefExp ->+      T.R (T.Fun a (T.Fun (T.List b) (T.Tuple2 (T.List b) (T.List b))))++hgenericSplitAt ::+  Integral a =>+  (T.R a) ->+    (T.R (T.List b)) -> T.RefExp -> T.R (T.Tuple2 (T.List b) (T.List b))++ggenericSplitAt pgenericSplitAt p =+  T.ufun2 agenericSplitAt pgenericSplitAt p hgenericSplitAt++hgenericSplitAt fv223v16v223v16n fxs p =+  T.ucguard+    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv223v16v223v16n+      (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 0))) (h fxs p)+    (y1genericSplitAt fv223v16v223v16n fxs p)+  where+  +  h fxs p =+    T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+      (T.con0 T.mkNoSrcPos p T.List T.aList) fxs+  h _ p = y1genericSplitAt fv223v16v223v16n fxs p+  +hgenericSplitAt fv223v16v223v16n fxs p = y1genericSplitAt fv223v16v223v16n fxs p++y1genericSplitAt _ (T.R T.List _) p =+  T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+    (T.con0 T.mkNoSrcPos p T.List T.aList)+    (T.con0 T.mkNoSrcPos p T.List T.aList)+y1genericSplitAt fn (T.R (T.Cons fx fxs) _) p =+  T.ucguard+    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !> p) fn+      (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 0)))+    (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+      (T.con2 T.mkNoSrcPos p T.Cons T.aCons fx (gxs' T.mkNoSrcPos p))+      (gxs'' T.mkNoSrcPos p))+    (T.ucguard (gotherwise T.mkNoSrcPos p)+      (T.uwrapForward p+        (herror+          (T.fromLitString T.mkNoSrcPos p+            "List.genericSplitAt: negative argument") p)) (T.fatal p))+  where+  +  gxs' pxs' p = T.uconstUse pxs' p sxs'+  +  gxs'' pxs' p = T.uconstUse pxs' p sxs''+  +  j228v14v228v23xs' =+    case+      T.uwrapForward p+        (hgenericSplitAt+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !- p) fn+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 1))) fxs p) of+      T.R (T.Tuple2 fxs' fxs'') kxs' -> (kxs',fxs',fxs'')+      _ -> T.fatal p+  +  sxs' =+    T.uconstDef p a228v15v228v17xs'+      (\ _ -> case j228v14v228v23xs' of (kxs',fxs',fxs'') -> fxs')+  +  sxs'' =+    T.uconstDef p a228v19v228v22xs''+      (\ _ -> case j228v14v228v23xs' of (kxs',fxs',fxs'') -> fxs'')+  +y1genericSplitAt _ _ p = T.fatal p++ggenericIndex ::+  Integral a => T.RefSrcPos -> T.RefExp -> T.R (T.Fun (T.List b) (T.Fun a b))++hgenericIndex :: Integral a => (T.R (T.List b)) -> (T.R a) -> T.RefExp -> T.R b++ggenericIndex pgenericIndex p =+  T.ufun2 agenericIndex pgenericIndex p hgenericIndex++hgenericIndex (z1genericIndex@(T.R (T.Cons fx _) _)) fv231v21v231v21n p =+  T.ucguard+    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv231v21v231v21n+      (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 0))) (h p)+    (y1genericIndex z1genericIndex fv231v21v231v21n p)+  where+  +  h p = T.projection T.mkNoSrcPos p fx+  h p = y1genericIndex z1genericIndex fv231v21v231v21n p+  +hgenericIndex z1genericIndex fv231v21v231v21n p =+  y1genericIndex z1genericIndex fv231v21v231v21n p++y1genericIndex (T.R (T.Cons _ fxs) _) fn p =+  T.ucguard+    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !> p) fn+      (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 0)))+    (T.uwrapForward p+      (hgenericIndex fxs+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !- p) fn+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 1))) p))+    (T.ucguard (gotherwise T.mkNoSrcPos p)+      (T.uwrapForward p+        (herror+          (T.fromLitString T.mkNoSrcPos p+            "List.genericIndex: negative argument") p)) (T.fatal p))+y1genericIndex _ _ p =+  T.uwrapForward p+    (herror+      (T.fromLitString T.mkNoSrcPos p "List.genericIndex: index too large") p)++ggenericReplicate ::+  Integral a => T.RefSrcPos -> T.RefExp -> T.R (T.Fun a (T.Fun b (T.List b)))++hgenericReplicate ::+  Integral a => (T.R a) -> (T.R b) -> T.RefExp -> T.R (T.List b)++ggenericReplicate pgenericReplicate p =+  T.ufun2 agenericReplicate pgenericReplicate p hgenericReplicate++hgenericReplicate fn fx p =+  T.uwrapForward p (hgenericTake fn (T.uwrapForward p (hrepeat fx p)) p)++gzip4 ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.List a)+          (T.Fun (T.List b)+            (T.Fun (T.List c) (T.Fun (T.List d) (T.List (T.Tuple4 a b c d))))))++szip4 ::+  T.R+    (T.Fun (T.List a)+      (T.Fun (T.List b)+        (T.Fun (T.List c) (T.Fun (T.List d) (T.List (T.Tuple4 a b c d))))))++gzip4 pzip4 p = T.uconstUse pzip4 p szip4++szip4 =+  T.uconstDef T.mkRoot azip4+    (\ p ->+      T.uap1 T.mkNoSrcPos p (gzipWith4 T.mkNoSrcPos p)+        (T.pa0 T.Tuple4 T.cn4 T.mkNoSrcPos p T.aTuple4))++gzip5 ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.List a)+          (T.Fun (T.List b)+            (T.Fun (T.List c)+              (T.Fun (T.List d)+                (T.Fun (T.List e) (T.List (T.Tuple5 a b c d e)))))))++szip5 ::+  T.R+    (T.Fun (T.List a)+      (T.Fun (T.List b)+        (T.Fun (T.List c)+          (T.Fun (T.List d) (T.Fun (T.List e) (T.List (T.Tuple5 a b c d e)))))))++gzip5 pzip5 p = T.uconstUse pzip5 p szip5++szip5 =+  T.uconstDef T.mkRoot azip5+    (\ p ->+      T.uap1 T.mkNoSrcPos p (gzipWith5 T.mkNoSrcPos p)+        (T.pa0 T.Tuple5 T.cn5 T.mkNoSrcPos p T.aTuple5))++gzip6 ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.List a)+          (T.Fun (T.List b)+            (T.Fun (T.List c)+              (T.Fun (T.List d)+                (T.Fun (T.List e)+                  (T.Fun (T.List f) (T.List (T.Tuple6 a b c d e f))))))))++szip6 ::+  T.R+    (T.Fun (T.List a)+      (T.Fun (T.List b)+        (T.Fun (T.List c)+          (T.Fun (T.List d)+            (T.Fun (T.List e)+              (T.Fun (T.List f) (T.List (T.Tuple6 a b c d e f))))))))++gzip6 pzip6 p = T.uconstUse pzip6 p szip6++szip6 =+  T.uconstDef T.mkRoot azip6+    (\ p ->+      T.uap1 T.mkNoSrcPos p (gzipWith6 T.mkNoSrcPos p)+        (T.pa0 T.Tuple6 T.cn6 T.mkNoSrcPos p T.aTuple6))++gzip7 ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.List a)+          (T.Fun (T.List b)+            (T.Fun (T.List c)+              (T.Fun (T.List d)+                (T.Fun (T.List e)+                  (T.Fun (T.List f)+                    (T.Fun (T.List g) (T.List (T.Tuple7 a b c d e f g)))))))))++szip7 ::+  T.R+    (T.Fun (T.List a)+      (T.Fun (T.List b)+        (T.Fun (T.List c)+          (T.Fun (T.List d)+            (T.Fun (T.List e)+              (T.Fun (T.List f)+                (T.Fun (T.List g) (T.List (T.Tuple7 a b c d e f g)))))))))++gzip7 pzip7 p = T.uconstUse pzip7 p szip7++szip7 =+  T.uconstDef T.mkRoot azip7+    (\ p ->+      T.uap1 T.mkNoSrcPos p (gzipWith7 T.mkNoSrcPos p)+        (T.pa0 T.Tuple7 T.cn7 T.mkNoSrcPos p T.aTuple7))++gzipWith4 ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.Fun a (T.Fun b (T.Fun c (T.Fun d e))))+          (T.Fun (T.List a)+            (T.Fun (T.List b)+              (T.Fun (T.List c) (T.Fun (T.List d) (T.List e))))))++hzipWith4 ::+  (T.R (T.Fun a (T.Fun b (T.Fun c (T.Fun d e))))) ->+    (T.R (T.List a)) ->+      (T.R (T.List b)) ->+        (T.R (T.List c)) -> (T.R (T.List d)) -> T.RefExp -> T.R (T.List e)++gzipWith4 pzipWith4 p = T.ufun5 azipWith4 pzipWith4 p hzipWith4++hzipWith4 fz (T.R (T.Cons fa fas) _) (T.R (T.Cons fb fbs) _)+  (T.R (T.Cons fc fcs) _) (T.R (T.Cons fd fds) _) p =+  T.con2 T.mkNoSrcPos p T.Cons T.aCons (T.uap4 T.mkNoSrcPos p fz fa fb fc fd)+    (T.uwrapForward p (hzipWith4 fz fas fbs fcs fds p))+hzipWith4 _ _ _ _ _ p = T.con0 T.mkNoSrcPos p T.List T.aList++gzipWith5 ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.Fun a (T.Fun b (T.Fun c (T.Fun d (T.Fun e f)))))+          (T.Fun (T.List a)+            (T.Fun (T.List b)+              (T.Fun (T.List c)+                (T.Fun (T.List d) (T.Fun (T.List e) (T.List f)))))))++hzipWith5 ::+  (T.R (T.Fun a (T.Fun b (T.Fun c (T.Fun d (T.Fun e f)))))) ->+    (T.R (T.List a)) ->+      (T.R (T.List b)) ->+        (T.R (T.List c)) ->+          (T.R (T.List d)) -> (T.R (T.List e)) -> T.RefExp -> T.R (T.List f)++gzipWith5 pzipWith5 p = T.ufun6 azipWith5 pzipWith5 p hzipWith5++hzipWith5 fz (T.R (T.Cons fa fas) _) (T.R (T.Cons fb fbs) _)+  (T.R (T.Cons fc fcs) _) (T.R (T.Cons fd fds) _) (T.R (T.Cons fe fes) _) p =+  T.con2 T.mkNoSrcPos p T.Cons T.aCons (T.uap5 T.mkNoSrcPos p fz fa fb fc fd fe)+    (T.uap6 T.mkNoSrcPos p (gzipWith5 T.mkNoSrcPos p) fz fas fbs fcs fds fes)+hzipWith5 _ _ _ _ _ _ p = T.con0 T.mkNoSrcPos p T.List T.aList++gzipWith6 ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.Fun a (T.Fun b (T.Fun c (T.Fun d (T.Fun e (T.Fun f g))))))+          (T.Fun (T.List a)+            (T.Fun (T.List b)+              (T.Fun (T.List c)+                (T.Fun (T.List d)+                  (T.Fun (T.List e) (T.Fun (T.List f) (T.List g))))))))++hzipWith6 ::+  (T.R (T.Fun a (T.Fun b (T.Fun c (T.Fun d (T.Fun e (T.Fun f g))))))) ->+    (T.R (T.List a)) ->+      (T.R (T.List b)) ->+        (T.R (T.List c)) ->+          (T.R (T.List d)) ->+            (T.R (T.List e)) -> (T.R (T.List f)) -> T.RefExp -> T.R (T.List g)++gzipWith6 pzipWith6 p = T.ufun7 azipWith6 pzipWith6 p hzipWith6++hzipWith6 fz (T.R (T.Cons fa fas) _) (T.R (T.Cons fb fbs) _)+  (T.R (T.Cons fc fcs) _) (T.R (T.Cons fd fds) _) (T.R (T.Cons fe fes) _)+  (T.R (T.Cons ff ffs) _) p =+  T.con2 T.mkNoSrcPos p T.Cons T.aCons+    (T.uap6 T.mkNoSrcPos p fz fa fb fc fd fe ff)+    (T.uap7 T.mkNoSrcPos p (gzipWith6 T.mkNoSrcPos p) fz fas fbs fcs fds fes+      ffs)+hzipWith6 _ _ _ _ _ _ _ p = T.con0 T.mkNoSrcPos p T.List T.aList++gzipWith7 ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun+          (T.Fun a+            (T.Fun b (T.Fun c (T.Fun d (T.Fun e (T.Fun f (T.Fun g h)))))))+          (T.Fun (T.List a)+            (T.Fun (T.List b)+              (T.Fun (T.List c)+                (T.Fun (T.List d)+                  (T.Fun (T.List e)+                    (T.Fun (T.List f) (T.Fun (T.List g) (T.List h)))))))))++hzipWith7 ::+  (T.R (T.Fun a (T.Fun b (T.Fun c (T.Fun d (T.Fun e (T.Fun f (T.Fun g h))))))))+    ->+    (T.R (T.List a)) ->+      (T.R (T.List b)) ->+        (T.R (T.List c)) ->+          (T.R (T.List d)) ->+            (T.R (T.List e)) ->+              (T.R (T.List f)) -> (T.R (T.List g)) -> T.RefExp -> T.R (T.List h)++gzipWith7 pzipWith7 p = T.ufun8 azipWith7 pzipWith7 p hzipWith7++hzipWith7 fz (T.R (T.Cons fa fas) _) (T.R (T.Cons fb fbs) _)+  (T.R (T.Cons fc fcs) _) (T.R (T.Cons fd fds) _) (T.R (T.Cons fe fes) _)+  (T.R (T.Cons ff ffs) _) (T.R (T.Cons fg fgs) _) p =+  T.con2 T.mkNoSrcPos p T.Cons T.aCons+    (T.uap7 T.mkNoSrcPos p fz fa fb fc fd fe ff fg)+    (T.uap8 T.mkNoSrcPos p (gzipWith7 T.mkNoSrcPos p) fz fas fbs fcs fds fes ffs+      fgs)+hzipWith7 _ _ _ _ _ _ _ _ p = T.con0 T.mkNoSrcPos p T.List T.aList++gunzip4 ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.List (T.Tuple4 a b c d))+          (T.Tuple4 (T.List a) (T.List b) (T.List c) (T.List d)))++sunzip4 ::+  T.R+    (T.Fun (T.List (T.Tuple4 a b c d))+      (T.Tuple4 (T.List a) (T.List b) (T.List c) (T.List d)))++gunzip4 punzip4 p = T.uconstUse punzip4 p sunzip4++sunzip4 =+  T.uconstDef T.mkRoot aunzip4+    (\ p ->+      T.uap2 T.mkNoSrcPos p (gfoldr T.mkNoSrcPos p)+        (T.ufun2 T.mkLambda T.mkNoSrcPos p+          (\ v278v35v279v61v1 v278v35v279v61v2 p ->+            case (v278v35v279v61v1,v278v35v279v61v2) of+              (T.R (T.Tuple4 fa fb fc fd) _+                  ,T.R ~(T.Tuple4 fas fbs fcs fds) _) ->+                let+                  gas pas p = T.uconstUse pas p sas+                  sas =+                    T.uconstDef p a0v0v0v0as+                      (\ p -> T.projection T.mkNoSrcPos p fas)+                  gbs pbs p = T.uconstUse pbs p sbs+                  sbs =+                    T.uconstDef p a0v0v0v0bs+                      (\ p -> T.projection T.mkNoSrcPos p fbs)+                  gcs pcs p = T.uconstUse pcs p scs+                  scs =+                    T.uconstDef p a0v0v0v0cs+                      (\ p -> T.projection T.mkNoSrcPos p fcs)+                  gds pds p = T.uconstUse pds p sds+                  sds =+                    T.uconstDef p a0v0v0v0ds+                      (\ p -> T.projection T.mkNoSrcPos p fds) in+                  (T.con4 T.mkNoSrcPos p T.Tuple4 T.aTuple4+                    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fa+                      (gas T.mkNoSrcPos p))+                    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fb+                      (gbs T.mkNoSrcPos p))+                    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fc+                      (gcs T.mkNoSrcPos p))+                    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fd+                      (gds T.mkNoSrcPos p)))+              _ -> T.fatal p))+        (T.con4 T.mkNoSrcPos p T.Tuple4 T.aTuple4+          (T.con0 T.mkNoSrcPos p T.List T.aList)+          (T.con0 T.mkNoSrcPos p T.List T.aList)+          (T.con0 T.mkNoSrcPos p T.List T.aList)+          (T.con0 T.mkNoSrcPos p T.List T.aList)))++gunzip5 ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.List (T.Tuple5 a b c d e))+          (T.Tuple5 (T.List a) (T.List b) (T.List c) (T.List d) (T.List e)))++sunzip5 ::+  T.R+    (T.Fun (T.List (T.Tuple5 a b c d e))+      (T.Tuple5 (T.List a) (T.List b) (T.List c) (T.List d) (T.List e)))++gunzip5 punzip5 p = T.uconstUse punzip5 p sunzip5++sunzip5 =+  T.uconstDef T.mkRoot aunzip5+    (\ p ->+      T.uap2 T.mkNoSrcPos p (gfoldr T.mkNoSrcPos p)+        (T.ufun2 T.mkLambda T.mkNoSrcPos p+          (\ v283v35v284v66v1 v283v35v284v66v2 p ->+            case (v283v35v284v66v1,v283v35v284v66v2) of+              (T.R (T.Tuple5 fa fb fc fd fe) _+                  ,T.R ~(T.Tuple5 fas fbs fcs fds fes) _) ->+                let+                  gas pas p = T.uconstUse pas p sas+                  sas =+                    T.uconstDef p a0v0v0v0as+                      (\ p -> T.projection T.mkNoSrcPos p fas)+                  gbs pbs p = T.uconstUse pbs p sbs+                  sbs =+                    T.uconstDef p a0v0v0v0bs+                      (\ p -> T.projection T.mkNoSrcPos p fbs)+                  gcs pcs p = T.uconstUse pcs p scs+                  scs =+                    T.uconstDef p a0v0v0v0cs+                      (\ p -> T.projection T.mkNoSrcPos p fcs)+                  gds pds p = T.uconstUse pds p sds+                  sds =+                    T.uconstDef p a0v0v0v0ds+                      (\ p -> T.projection T.mkNoSrcPos p fds)+                  ges pes p = T.uconstUse pes p ses+                  ses =+                    T.uconstDef p a0v0v0v0es+                      (\ p -> T.projection T.mkNoSrcPos p fes) in+                  (T.con5 T.mkNoSrcPos p T.Tuple5 T.aTuple5+                    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fa+                      (gas T.mkNoSrcPos p))+                    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fb+                      (gbs T.mkNoSrcPos p))+                    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fc+                      (gcs T.mkNoSrcPos p))+                    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fd+                      (gds T.mkNoSrcPos p))+                    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fe+                      (ges T.mkNoSrcPos p)))+              _ -> T.fatal p))+        (T.con5 T.mkNoSrcPos p T.Tuple5 T.aTuple5+          (T.con0 T.mkNoSrcPos p T.List T.aList)+          (T.con0 T.mkNoSrcPos p T.List T.aList)+          (T.con0 T.mkNoSrcPos p T.List T.aList)+          (T.con0 T.mkNoSrcPos p T.List T.aList)+          (T.con0 T.mkNoSrcPos p T.List T.aList)))++gunzip6 ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.List (T.Tuple6 a b c d e f))+          (T.Tuple6 (T.List a) (T.List b) (T.List c) (T.List d) (T.List e)+            (T.List f)))++sunzip6 ::+  T.R+    (T.Fun (T.List (T.Tuple6 a b c d e f))+      (T.Tuple6 (T.List a) (T.List b) (T.List c) (T.List d) (T.List e)+        (T.List f)))++gunzip6 punzip6 p = T.uconstUse punzip6 p sunzip6++sunzip6 =+  T.uconstDef T.mkRoot aunzip6+    (\ p ->+      T.uap2 T.mkNoSrcPos p (gfoldr T.mkNoSrcPos p)+        (T.ufun2 T.mkLambda T.mkNoSrcPos p+          (\ v288v35v289v71v1 v288v35v289v71v2 p ->+            case (v288v35v289v71v1,v288v35v289v71v2) of+              (T.R (T.Tuple6 fa fb fc fd fe ff) _+                  ,T.R ~(T.Tuple6 fas fbs fcs fds fes ffs) _) ->+                let+                  gas pas p = T.uconstUse pas p sas+                  sas =+                    T.uconstDef p a0v0v0v0as+                      (\ p -> T.projection T.mkNoSrcPos p fas)+                  gbs pbs p = T.uconstUse pbs p sbs+                  sbs =+                    T.uconstDef p a0v0v0v0bs+                      (\ p -> T.projection T.mkNoSrcPos p fbs)+                  gcs pcs p = T.uconstUse pcs p scs+                  scs =+                    T.uconstDef p a0v0v0v0cs+                      (\ p -> T.projection T.mkNoSrcPos p fcs)+                  gds pds p = T.uconstUse pds p sds+                  sds =+                    T.uconstDef p a0v0v0v0ds+                      (\ p -> T.projection T.mkNoSrcPos p fds)+                  ges pes p = T.uconstUse pes p ses+                  ses =+                    T.uconstDef p a0v0v0v0es+                      (\ p -> T.projection T.mkNoSrcPos p fes)+                  gfs pfs p = T.uconstUse pfs p sfs+                  sfs =+                    T.uconstDef p a0v0v0v0fs+                      (\ p -> T.projection T.mkNoSrcPos p ffs) in+                  (T.con6 T.mkNoSrcPos p T.Tuple6 T.aTuple6+                    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fa+                      (gas T.mkNoSrcPos p))+                    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fb+                      (gbs T.mkNoSrcPos p))+                    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fc+                      (gcs T.mkNoSrcPos p))+                    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fd+                      (gds T.mkNoSrcPos p))+                    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fe+                      (ges T.mkNoSrcPos p))+                    (T.con2 T.mkNoSrcPos p T.Cons T.aCons ff+                      (gfs T.mkNoSrcPos p)))+              _ -> T.fatal p))+        (T.con6 T.mkNoSrcPos p T.Tuple6 T.aTuple6+          (T.con0 T.mkNoSrcPos p T.List T.aList)+          (T.con0 T.mkNoSrcPos p T.List T.aList)+          (T.con0 T.mkNoSrcPos p T.List T.aList)+          (T.con0 T.mkNoSrcPos p T.List T.aList)+          (T.con0 T.mkNoSrcPos p T.List T.aList)+          (T.con0 T.mkNoSrcPos p T.List T.aList)))++gunzip7 ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.List (T.Tuple7 a b c d e f g))+          (T.Tuple7 (T.List a) (T.List b) (T.List c) (T.List d) (T.List e)+            (T.List f) (T.List g)))++sunzip7 ::+  T.R+    (T.Fun (T.List (T.Tuple7 a b c d e f g))+      (T.Tuple7 (T.List a) (T.List b) (T.List c) (T.List d) (T.List e)+        (T.List f) (T.List g)))++gunzip7 punzip7 p = T.uconstUse punzip7 p sunzip7++sunzip7 =+  T.uconstDef T.mkRoot aunzip7+    (\ p ->+      T.uap2 T.mkNoSrcPos p (gfoldr T.mkNoSrcPos p)+        (T.ufun2 T.mkLambda T.mkNoSrcPos p+          (\ v293v27v294v68v1 v293v27v294v68v2 p ->+            case (v293v27v294v68v1,v293v27v294v68v2) of+              (T.R (T.Tuple7 fa fb fc fd fe ff fg) _+                  ,T.R ~(T.Tuple7 fas fbs fcs fds fes ffs fgs) _) ->+                let+                  gas pas p = T.uconstUse pas p sas+                  sas =+                    T.uconstDef p a0v0v0v0as+                      (\ p -> T.projection T.mkNoSrcPos p fas)+                  gbs pbs p = T.uconstUse pbs p sbs+                  sbs =+                    T.uconstDef p a0v0v0v0bs+                      (\ p -> T.projection T.mkNoSrcPos p fbs)+                  gcs pcs p = T.uconstUse pcs p scs+                  scs =+                    T.uconstDef p a0v0v0v0cs+                      (\ p -> T.projection T.mkNoSrcPos p fcs)+                  gds pds p = T.uconstUse pds p sds+                  sds =+                    T.uconstDef p a0v0v0v0ds+                      (\ p -> T.projection T.mkNoSrcPos p fds)+                  ges pes p = T.uconstUse pes p ses+                  ses =+                    T.uconstDef p a0v0v0v0es+                      (\ p -> T.projection T.mkNoSrcPos p fes)+                  gfs pfs p = T.uconstUse pfs p sfs+                  sfs =+                    T.uconstDef p a0v0v0v0fs+                      (\ p -> T.projection T.mkNoSrcPos p ffs)+                  ggs pgs p = T.uconstUse pgs p sgs+                  sgs =+                    T.uconstDef p a0v0v0v0gs+                      (\ p -> T.projection T.mkNoSrcPos p fgs) in+                  (T.con7 T.mkNoSrcPos p T.Tuple7 T.aTuple7+                    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fa+                      (gas T.mkNoSrcPos p))+                    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fb+                      (gbs T.mkNoSrcPos p))+                    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fc+                      (gcs T.mkNoSrcPos p))+                    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fd+                      (gds T.mkNoSrcPos p))+                    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fe+                      (ges T.mkNoSrcPos p))+                    (T.con2 T.mkNoSrcPos p T.Cons T.aCons ff+                      (gfs T.mkNoSrcPos p))+                    (T.con2 T.mkNoSrcPos p T.Cons T.aCons fg+                      (ggs T.mkNoSrcPos p)))+              _ -> T.fatal p))+        (T.con7 T.mkNoSrcPos p T.Tuple7 T.aTuple7+          (T.con0 T.mkNoSrcPos p T.List T.aList)+          (T.con0 T.mkNoSrcPos p T.List T.aList)+          (T.con0 T.mkNoSrcPos p T.List T.aList)+          (T.con0 T.mkNoSrcPos p T.List T.aList)+          (T.con0 T.mkNoSrcPos p T.List T.aList)+          (T.con0 T.mkNoSrcPos p T.List T.aList)+          (T.con0 T.mkNoSrcPos p T.List T.aList)))++tList = T.mkModule "List" "List.hs" Prelude.False++aelemIndex = T.mkVariable tList 340001 340042 3 1 "elemIndex" Prelude.False++aelemIndices = T.mkVariable tList 370001 370044 3 1 "elemIndices" Prelude.False++afind = T.mkVariable tList 400001 400049 3 1 "find" Prelude.False++afindIndex = T.mkVariable tList 430001 430054 3 1 "findIndex" Prelude.False++afindIndices = T.mkVariable tList 460001 460011 3 2 "findIndices" Prelude.False++anub = T.mkVariable tList 490001 490036 3 0 "nub" Prelude.False++anubBy = T.mkVariable tList 520001 530071 3 2 "nubBy" Prelude.False++adelete = T.mkVariable tList 560001 560039 3 0 "delete" Prelude.False++adeleteBy = T.mkVariable tList 590001 600071 3 3 "deleteBy" Prelude.False++(+\\) = T.mkVariable tList 630002 630045 20 0 "\\\\" Prelude.False++adeleteFirstsBy =+  T.mkVariable tList 660001 660051 3 1 "deleteFirstsBy" Prelude.False++aunion = T.mkVariable tList 690001 690038 3 0 "union" Prelude.False++aunionBy = T.mkVariable tList 720001 720067 3 3 "unionBy" Prelude.False++aintersect = T.mkVariable tList 750001 750042 3 0 "intersect" Prelude.False++aintersectBy = T.mkVariable tList 780001 780011 3 3 "intersectBy" Prelude.False++aintersperse = T.mkVariable tList 810001 830055 3 2 "intersperse" Prelude.False++atranspose = T.mkVariable tList 910001 940040 3 1 "transpose" Prelude.False++apartition = T.mkVariable tList 970001 970061 3 2 "partition" Prelude.False++agroup = T.mkVariable tList 1030001 1030038 3 0 "group" Prelude.False++agroupBy = T.mkVariable tList 1060001 1080057 3 2 "groupBy" Prelude.False++ainits = T.mkVariable tList 1130001 1140053 3 1 "inits" Prelude.False++atails = T.mkVariable tList 1190001 1200041 3 1 "tails" Prelude.False++aisPrefixOf = T.mkVariable tList 1230001 1250054 3 2 "isPrefixOf" Prelude.False++aisSuffixOf = T.mkVariable tList 1280001 1280059 3 2 "isSuffixOf" Prelude.False++amapAccumL = T.mkVariable tList 1310001 1340061 3 3 "mapAccumL" Prelude.False++amapAccumR = T.mkVariable tList 1370001 1400060 3 3 "mapAccumR" Prelude.False++aunfoldr = T.mkVariable tList 1430001 1450061 3 2 "unfoldr" Prelude.False++asort = T.mkVariable tList 1480001 1480041 3 0 "sort" Prelude.False++asortBy = T.mkVariable tList 1510001 1760028 3 1 "sortBy" Prelude.False++ainsert = T.mkVariable tList 1790001 1790042 3 0 "insert" Prelude.False++ainsertBy = T.mkVariable tList 1820001 1860044 3 3 "insertBy" Prelude.False++amaximumBy = T.mkVariable tList 1890001 1940047 3 2 "maximumBy" Prelude.False++aminimumBy = T.mkVariable tList 1970001 2020047 3 2 "minimumBy" Prelude.False++agenericLength =+  T.mkVariable tList 2050001 2060047 3 1 "genericLength" Prelude.False++agenericTake =+  T.mkVariable tList 2090001 2130070 3 2 "genericTake" Prelude.False++agenericDrop =+  T.mkVariable tList 2160001 2200070 3 2 "genericDrop" Prelude.False++agenericSplitAt =+  T.mkVariable tList 2230001 2280050 3 2 "genericSplitAt" Prelude.False++agenericIndex =+  T.mkVariable tList 2310001 2350069 3 2 "genericIndex" Prelude.False++agenericReplicate =+  T.mkVariable tList 2380001 2380050 3 2 "genericReplicate" Prelude.False++azip4 = T.mkVariable tList 2410001 2410041 3 0 "zip4" Prelude.False++azip5 = T.mkVariable tList 2440001 2440042 3 0 "zip5" Prelude.False++azip6 = T.mkVariable tList 2480001 2480043 3 0 "zip6" Prelude.False++azip7 = T.mkVariable tList 2520001 2520044 3 0 "zip7" Prelude.False++azipWith4 = T.mkVariable tList 2550001 2570029 3 5 "zipWith4" Prelude.False++azipWith5 = T.mkVariable tList 2610001 2630029 3 6 "zipWith5" Prelude.False++azipWith6 = T.mkVariable tList 2670001 2690029 3 7 "zipWith6" Prelude.False++azipWith7 = T.mkVariable tList 2730001 2750029 3 8 "zipWith7" Prelude.False++aunzip4 = T.mkVariable tList 2780001 2800046 3 0 "unzip4" Prelude.False++aunzip5 = T.mkVariable tList 2830001 2850049 3 0 "unzip5" Prelude.False++aunzip6 = T.mkVariable tList 2880001 2900052 3 0 "unzip6" Prelude.False++aunzip7 = T.mkVariable tList 2930001 2950047 3 0 "unzip7" Prelude.False++a108v35v108v36ys = T.mkVariable tList 1080035 1080036 3 0 "ys" Prelude.True++a108v38v108v39zs = T.mkVariable tList 1080038 1080039 3 0 "zs" Prelude.True++a133v35v133v36s' = T.mkVariable tList 1330035 1330036 3 0 "s'" Prelude.True++a133v39v133v39y = T.mkVariable tList 1330039 1330039 3 0 "y" Prelude.True++a134v35v134v37s'' = T.mkVariable tList 1340035 1340037 3 0 "s''" Prelude.True++a134v39v134v40ys = T.mkVariable tList 1340039 1340040 3 0 "ys" Prelude.True++a139v35v139v37s'' = T.mkVariable tList 1390035 1390037 3 0 "s''" Prelude.True++a139v39v139v39y = T.mkVariable tList 1390039 1390039 3 0 "y" Prelude.True++a140v35v140v36s' = T.mkVariable tList 1400035 1400036 3 0 "s'" Prelude.True++a140v39v140v40ys = T.mkVariable tList 1400039 1400040 3 0 "ys" Prelude.True++a153v5v156v23sequences =+  T.mkVariable tList 1530005 1560023 3 1 "sequences" Prelude.True++a158v5v160v46descending =+  T.mkVariable tList 1580005 1600046 3 3 "descending" Prelude.True++a162v5v164v46ascending =+  T.mkVariable tList 1620005 1640046 3 3 "ascending" Prelude.True++a166v5v167v42mergeAll =+  T.mkVariable tList 1660005 1670042 3 1 "mergeAll" Prelude.True++a169v5v170v28mergePairs =+  T.mkVariable tList 1690005 1700028 3 1 "mergePairs" Prelude.True++a172v5v176v28merge = T.mkVariable tList 1720005 1760028 3 2 "merge" Prelude.True++a192v28v194v47max = T.mkVariable tList 1920028 1940047 3 2 "max" Prelude.True++a200v28v202v47min = T.mkVariable tList 2000028 2020047 3 2 "min" Prelude.True++a228v15v228v17xs' = T.mkVariable tList 2280015 2280017 3 0 "xs'" Prelude.True++a228v19v228v22xs'' = T.mkVariable tList 2280019 2280022 3 0 "xs''" Prelude.True++a0v0v0v0as = T.mkVariable tList 0 0 3 0 "as" Prelude.True++a0v0v0v0bs = T.mkVariable tList 0 0 3 0 "bs" Prelude.True++a0v0v0v0cs = T.mkVariable tList 0 0 3 0 "cs" Prelude.True++a0v0v0v0ds = T.mkVariable tList 0 0 3 0 "ds" Prelude.True++a0v0v0v0es = T.mkVariable tList 0 0 3 0 "es" Prelude.True++a0v0v0v0fs = T.mkVariable tList 0 0 3 0 "fs" Prelude.True++a0v0v0v0gs = T.mkVariable tList 0 0 3 0 "gs" Prelude.True
+ Hat/Locale.hs view
@@ -0,0 +1,439 @@+module Hat.Locale+  (TimeLocale(TimeLocale,bwDays,bmonths,bamPm,bdateTimeFmt,bdateFmt,btimeFmt+      ,btime12Fmt),gwDays,gmonths,gamPm,gdateTimeFmt,gdateFmt,gtimeFmt+    ,gtime12Fmt,hwDays,hmonths,hamPm,hdateTimeFmt,hdateFmt,htimeFmt,htime12Fmt+    ,awDays,amonths,aamPm,adateTimeFmt,adateFmt,atimeFmt,atime12Fmt,aTimeLocale+    ,gdefaultTimeLocale) where++import qualified Hat.PreludeBasic +import qualified Prelude +import Hat.Hack +import qualified Hat.Hat as T +import Hat.Hat  (WrapVal(wrapVal))+import Hat.Prelude ++data TimeLocale =+  TimeLocale+    {bwDays :: T.R (T.List (T.Tuple2 String String))+      ,bmonths :: T.R (T.List (T.Tuple2 String String))+      ,bamPm :: T.R (T.Tuple2 String String)+      ,bdateTimeFmt,bdateFmt,btimeFmt,btime12Fmt :: T.R String}++instance T.WrapVal (TimeLocale)+  where+  +  wrapVal pwrapVal+    (kwrapVal@(TimeLocale (T.R _ z1wrapVal) (T.R _ z2wrapVal) (T.R _ z3wrapVal)+        (T.R _ z4wrapVal) (T.R _ z5wrapVal) (T.R _ z6wrapVal)+        (T.R _ z7wrapVal))) p =+    T.R kwrapVal+      (T.mkValueApp7 p pwrapVal aTimeLocale z1wrapVal z2wrapVal z3wrapVal+        z4wrapVal z5wrapVal z6wrapVal z7wrapVal)+  ++gwDays pwDays p = T.ufun1 awDays pwDays p hwDays++hwDays (T.R z1wDays _) p = T.projection T.mkNoSrcPos p (bwDays z1wDays)++gmonths pmonths p = T.ufun1 amonths pmonths p hmonths++hmonths (T.R z1months _) p = T.projection T.mkNoSrcPos p (bmonths z1months)++gamPm pamPm p = T.ufun1 aamPm pamPm p hamPm++hamPm (T.R z1amPm _) p = T.projection T.mkNoSrcPos p (bamPm z1amPm)++gdateTimeFmt pdateTimeFmt p = T.ufun1 adateTimeFmt pdateTimeFmt p hdateTimeFmt++hdateTimeFmt (T.R z1dateTimeFmt _) p =+  T.projection T.mkNoSrcPos p (bdateTimeFmt z1dateTimeFmt)++gdateFmt pdateFmt p = T.ufun1 adateFmt pdateFmt p hdateFmt++hdateFmt (T.R z1dateFmt _) p = T.projection T.mkNoSrcPos p (bdateFmt z1dateFmt)++gtimeFmt ptimeFmt p = T.ufun1 atimeFmt ptimeFmt p htimeFmt++htimeFmt (T.R z1timeFmt _) p = T.projection T.mkNoSrcPos p (btimeFmt z1timeFmt)++gtime12Fmt ptime12Fmt p = T.ufun1 atime12Fmt ptime12Fmt p htime12Fmt++htime12Fmt (T.R z1time12Fmt _) p =+  T.projection T.mkNoSrcPos p (btime12Fmt z1time12Fmt)++instance Eq (TimeLocale)+  where+  +  (!==) (%==) p =+    T.ufun2 (+##=$#=##=$$==) (%==) p (*==)+    where+    +    (*==) (T.R (TimeLocale fy1 fy2 fy3 fy4 fy5 fy6 fy7) _)+      (T.R (TimeLocale fy8 fy9 fy10 fy11 fy12 fy13 fy14) _) p =+      T.uwrapForward p+        (((T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fy1 fy8)+            Hat.Prelude.*&&+            (T.uwrapForward p+              (((T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fy2 fy9)+                  Hat.Prelude.*&&+                  (T.uwrapForward p+                    (((T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p)+                          fy3 fy10)+                        Hat.Prelude.*&&+                        (T.uwrapForward p+                          (((T.uap2 T.mkNoSrcPos p+                                (T.mkNoSrcPos Hat.Prelude.!== p) fy4 fy11)+                              Hat.Prelude.*&&+                              (T.uwrapForward p+                                (((T.uap2 T.mkNoSrcPos p+                                      (T.mkNoSrcPos Hat.Prelude.!== p) fy5 fy12)+                                    Hat.Prelude.*&&+                                    (T.uwrapForward p+                                      (((T.uap2 T.mkNoSrcPos p+                                            (T.mkNoSrcPos Hat.Prelude.!== p) fy6+                                            fy13)+                                          Hat.Prelude.*&&+                                          (T.uap2 T.mkNoSrcPos p+                                            (T.mkNoSrcPos Hat.Prelude.!== p) fy7+                                            fy14)) p))) p))) p))) p))) p))) p)+    (*==) _ _ p = T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse+    +  ++instance Ord (TimeLocale)+  where+  +  gcompare pcompare p =+    T.ufun2 a11v25v11v27compare pcompare p hcompare+    where+    +    hcompare (T.R (TimeLocale fy3 fy4 fy5 fy6 fy7 fy8 fy9) _)+      (T.R (TimeLocale fy10 fy11 fy12 fy13 fy14 fy15 fy16) _) p =+      T.uccase T.mkNoSrcPos p+        (let+          v11v25v11v27v1 (T.R Hat.Prelude.EQ _) p =+            T.uccase T.mkNoSrcPos p+              (let+                v11v25v11v27v1 (T.R Hat.Prelude.EQ _) p =+                  T.uccase T.mkNoSrcPos p+                    (let+                      v11v25v11v27v1 (T.R Hat.Prelude.EQ _) p =+                        T.uccase T.mkNoSrcPos p+                          (let+                            v11v25v11v27v1 (T.R Hat.Prelude.EQ _) p =+                              T.uccase T.mkNoSrcPos p+                                (let+                                  v11v25v11v27v1 (T.R Hat.Prelude.EQ _) p =+                                    T.uccase T.mkNoSrcPos p+                                      (let+                                        v11v25v11v27v1 (T.R Hat.Prelude.EQ _)+                                          p =+                                          T.uap2 T.mkNoSrcPos p+                                            (Hat.Prelude.gcompare T.mkNoSrcPos+                                              p) fy9 fy16+                                        v11v25v11v27v1 fy1 p =+                                          T.projection T.mkNoSrcPos p fy1 in+                                        (v11v25v11v27v1))+                                      (T.uap2 T.mkNoSrcPos p+                                        (Hat.Prelude.gcompare T.mkNoSrcPos p)+                                        fy8 fy15)+                                  v11v25v11v27v1 fy1 p =+                                    T.projection T.mkNoSrcPos p fy1 in+                                  (v11v25v11v27v1))+                                (T.uap2 T.mkNoSrcPos p+                                  (Hat.Prelude.gcompare T.mkNoSrcPos p) fy7+                                  fy14)+                            v11v25v11v27v1 fy1 p =+                              T.projection T.mkNoSrcPos p fy1 in+                            (v11v25v11v27v1))+                          (T.uap2 T.mkNoSrcPos p+                            (Hat.Prelude.gcompare T.mkNoSrcPos p) fy6 fy13)+                      v11v25v11v27v1 fy1 p = T.projection T.mkNoSrcPos p fy1 in+                      (v11v25v11v27v1))+                    (T.uap2 T.mkNoSrcPos p (Hat.Prelude.gcompare T.mkNoSrcPos p)+                      fy5 fy12)+                v11v25v11v27v1 fy1 p = T.projection T.mkNoSrcPos p fy1 in+                (v11v25v11v27v1))+              (T.uap2 T.mkNoSrcPos p (Hat.Prelude.gcompare T.mkNoSrcPos p) fy4+                fy11)+          v11v25v11v27v1 fy1 p = T.projection T.mkNoSrcPos p fy1 in+          (v11v25v11v27v1))+        (T.uap2 T.mkNoSrcPos p (Hat.Prelude.gcompare T.mkNoSrcPos p) fy3 fy10)+    hcompare fy1 fy2 p =+      T.uap2 T.mkNoSrcPos p (Hat.Prelude.gcompare T.mkNoSrcPos p)+        (T.uwrapForward p (hlocalFromEnum fy1 p) :: T.R Hat.Prelude.Int)+        (T.uwrapForward p (hlocalFromEnum fy2 p))+      where+      +      glocalFromEnum plocalFromEnum p =+        T.ufun1 a11v25v11v27localFromEnum plocalFromEnum p hlocalFromEnum+      +      alocalFromEnum = a11v25v11v27localFromEnum+      +      hlocalFromEnum (T.R (TimeLocale _ _ _ _ _ _ _) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0)+      hlocalFromEnum _ p = T.fatal p+      +    +  ++instance Show (TimeLocale)+  where+  +  gshowsPrec pshowsPrec p =+    T.ufun2 a11v30v11v33showsPrec pshowsPrec p hshowsPrec+    where+    +    hshowsPrec fy1 (T.R (TimeLocale fy2 fy3 fy4 fy5 fy6 fy7 fy8) _) p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+          (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+            (T.fromLitString T.mkNoSrcPos p "TimeLocale{"))+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                  (T.uap1 T.mkNoSrcPos p+                    (Hat.Prelude.gshowString T.mkNoSrcPos p)+                    (T.fromLitString T.mkNoSrcPos p "wDays"))+                  (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                    (T.conChar T.mkNoSrcPos p '=')))+                (T.uap2 T.mkNoSrcPos p (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                  (T.uap1 T.mkNoSrcPos p+                    (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                    (T.conInteger T.mkNoSrcPos p 0)) fy2))+              (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                (T.conChar T.mkNoSrcPos p ',')))+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                    (T.uap1 T.mkNoSrcPos p+                      (Hat.Prelude.gshowString T.mkNoSrcPos p)+                      (T.fromLitString T.mkNoSrcPos p "months"))+                    (T.uap1 T.mkNoSrcPos p+                      (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                      (T.conChar T.mkNoSrcPos p '=')))+                  (T.uap2 T.mkNoSrcPos p (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                    (T.uap1 T.mkNoSrcPos p+                      (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                      (T.conInteger T.mkNoSrcPos p 0)) fy3))+                (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                  (T.conChar T.mkNoSrcPos p ',')))+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                      (T.uap1 T.mkNoSrcPos p+                        (Hat.Prelude.gshowString T.mkNoSrcPos p)+                        (T.fromLitString T.mkNoSrcPos p "amPm"))+                      (T.uap1 T.mkNoSrcPos p+                        (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                        (T.conChar T.mkNoSrcPos p '=')))+                    (T.uap2 T.mkNoSrcPos p+                      (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                      (T.uap1 T.mkNoSrcPos p+                        (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                        (T.conInteger T.mkNoSrcPos p 0)) fy4))+                  (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                    (T.conChar T.mkNoSrcPos p ',')))+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                        (T.uap1 T.mkNoSrcPos p+                          (Hat.Prelude.gshowString T.mkNoSrcPos p)+                          (T.fromLitString T.mkNoSrcPos p "dateTimeFmt"))+                        (T.uap1 T.mkNoSrcPos p+                          (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                          (T.conChar T.mkNoSrcPos p '=')))+                      (T.uap2 T.mkNoSrcPos p+                        (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                        (T.uap1 T.mkNoSrcPos p+                          (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                          (T.conInteger T.mkNoSrcPos p 0)) fy5))+                    (T.uap1 T.mkNoSrcPos p+                      (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                      (T.conChar T.mkNoSrcPos p ',')))+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                          (T.uap1 T.mkNoSrcPos p+                            (Hat.Prelude.gshowString T.mkNoSrcPos p)+                            (T.fromLitString T.mkNoSrcPos p "dateFmt"))+                          (T.uap1 T.mkNoSrcPos p+                            (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                            (T.conChar T.mkNoSrcPos p '=')))+                        (T.uap2 T.mkNoSrcPos p+                          (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                          (T.uap1 T.mkNoSrcPos p+                            (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                            (T.conInteger T.mkNoSrcPos p 0)) fy6))+                      (T.uap1 T.mkNoSrcPos p+                        (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                        (T.conChar T.mkNoSrcPos p ',')))+                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                            (T.uap1 T.mkNoSrcPos p+                              (Hat.Prelude.gshowString T.mkNoSrcPos p)+                              (T.fromLitString T.mkNoSrcPos p "timeFmt"))+                            (T.uap1 T.mkNoSrcPos p+                              (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                              (T.conChar T.mkNoSrcPos p '=')))+                          (T.uap2 T.mkNoSrcPos p+                            (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                            (T.uap1 T.mkNoSrcPos p+                              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                              (T.conInteger T.mkNoSrcPos p 0)) fy7))+                        (T.uap1 T.mkNoSrcPos p+                          (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                          (T.conChar T.mkNoSrcPos p ',')))+                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                          (T.uap1 T.mkNoSrcPos p+                            (Hat.Prelude.gshowString T.mkNoSrcPos p)+                            (T.fromLitString T.mkNoSrcPos p "time12Fmt"))+                          (T.uap1 T.mkNoSrcPos p+                            (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                            (T.conChar T.mkNoSrcPos p '=')))+                        (T.uap2 T.mkNoSrcPos p+                          (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                          (T.uap1 T.mkNoSrcPos p+                            (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                            (T.conInteger T.mkNoSrcPos p 0)) fy8)))))))))+        (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowChar T.mkNoSrcPos p)+          (T.conChar T.mkNoSrcPos p '}'))+    hshowsPrec _ _ p = T.fatal p+    +  ++gdefaultTimeLocale :: T.RefSrcPos -> T.RefExp -> T.R TimeLocale++sdefaultTimeLocale :: T.R TimeLocale++gdefaultTimeLocale pdefaultTimeLocale p =+  T.uconstUse pdefaultTimeLocale p sdefaultTimeLocale++sdefaultTimeLocale =+  T.uconstDef T.mkRoot adefaultTimeLocale+    (\ p ->+      T.wrapVal T.mkNoSrcPos+        ((TimeLocale (Hat.PreludeBasic.gundefined T.mkNoSrcPos p)+            (Hat.PreludeBasic.gundefined T.mkNoSrcPos p)+            (Hat.PreludeBasic.gundefined T.mkNoSrcPos p)+            (Hat.PreludeBasic.gundefined T.mkNoSrcPos p)+            (Hat.PreludeBasic.gundefined T.mkNoSrcPos p)+            (Hat.PreludeBasic.gundefined T.mkNoSrcPos p)+            (Hat.PreludeBasic.gundefined T.mkNoSrcPos p))+          {bwDays+            = T.fromExpList T.mkNoSrcPos p+              [T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                  (T.fromLitString T.mkNoSrcPos p "Sunday")+                  (T.fromLitString T.mkNoSrcPos p "Sun")+                ,T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                  (T.fromLitString T.mkNoSrcPos p "Monday")+                  (T.fromLitString T.mkNoSrcPos p "Mon")+                ,T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                  (T.fromLitString T.mkNoSrcPos p "Tuesday")+                  (T.fromLitString T.mkNoSrcPos p "Tue")+                ,T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                  (T.fromLitString T.mkNoSrcPos p "Wednesday")+                  (T.fromLitString T.mkNoSrcPos p "Wed")+                ,T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                  (T.fromLitString T.mkNoSrcPos p "Thursday")+                  (T.fromLitString T.mkNoSrcPos p "Thu")+                ,T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                  (T.fromLitString T.mkNoSrcPos p "Friday")+                  (T.fromLitString T.mkNoSrcPos p "Fri")+                ,T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                  (T.fromLitString T.mkNoSrcPos p "Saturday")+                  (T.fromLitString T.mkNoSrcPos p "Sat")]+          ,bmonths+            = T.fromExpList T.mkNoSrcPos p+              [T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                  (T.fromLitString T.mkNoSrcPos p "January")+                  (T.fromLitString T.mkNoSrcPos p "Jan")+                ,T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                  (T.fromLitString T.mkNoSrcPos p "February")+                  (T.fromLitString T.mkNoSrcPos p "Feb")+                ,T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                  (T.fromLitString T.mkNoSrcPos p "March")+                  (T.fromLitString T.mkNoSrcPos p "Mar")+                ,T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                  (T.fromLitString T.mkNoSrcPos p "April")+                  (T.fromLitString T.mkNoSrcPos p "Apr")+                ,T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                  (T.fromLitString T.mkNoSrcPos p "May")+                  (T.fromLitString T.mkNoSrcPos p "May")+                ,T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                  (T.fromLitString T.mkNoSrcPos p "June")+                  (T.fromLitString T.mkNoSrcPos p "Jun")+                ,T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                  (T.fromLitString T.mkNoSrcPos p "July")+                  (T.fromLitString T.mkNoSrcPos p "Jul")+                ,T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                  (T.fromLitString T.mkNoSrcPos p "August")+                  (T.fromLitString T.mkNoSrcPos p "Aug")+                ,T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                  (T.fromLitString T.mkNoSrcPos p "September")+                  (T.fromLitString T.mkNoSrcPos p "Sep")+                ,T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                  (T.fromLitString T.mkNoSrcPos p "October")+                  (T.fromLitString T.mkNoSrcPos p "Oct")+                ,T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                  (T.fromLitString T.mkNoSrcPos p "November")+                  (T.fromLitString T.mkNoSrcPos p "Nov")+                ,T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                  (T.fromLitString T.mkNoSrcPos p "December")+                  (T.fromLitString T.mkNoSrcPos p "Dec")]+          ,bamPm+            = T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+              (T.fromLitString T.mkNoSrcPos p "AM")+              (T.fromLitString T.mkNoSrcPos p "PM")+          ,bdateTimeFmt+            = T.fromLitString T.mkNoSrcPos p "%a %b %e %H:%M:%S %Z %Y"+          ,bdateFmt = T.fromLitString T.mkNoSrcPos p "%m/%d/%y"+          ,btimeFmt = T.fromLitString T.mkNoSrcPos p "%H:%M:%S"+          ,btime12Fmt = T.fromLitString T.mkNoSrcPos p "%I:%M:%S %p"}) p)++tLocale = T.mkModule "Locale" "Locale.hs" Prelude.False++aTimeLocale =+  T.mkConstructorWFields tLocale 50019 50028 3 7 "TimeLocale"+    (awDays+      :+      (amonths+        :+        (aamPm : (adateTimeFmt : (adateFmt : (atimeFmt : (atime12Fmt : [])))))))++awDays = T.mkVariable tLocale 60009 60013 3 1 "wDays" Prelude.False++amonths = T.mkVariable tLocale 70009 70014 3 1 "months" Prelude.False++aamPm = T.mkVariable tLocale 80009 80012 3 1 "amPm" Prelude.False++adateTimeFmt = T.mkVariable tLocale 90009 90019 3 1 "dateTimeFmt" Prelude.False++adateFmt = T.mkVariable tLocale 90022 90028 3 1 "dateFmt" Prelude.False++atimeFmt = T.mkVariable tLocale 100011 100017 3 1 "timeFmt" Prelude.False++atime12Fmt = T.mkVariable tLocale 100020 100028 3 1 "time12Fmt" Prelude.False++adefaultTimeLocale =+  T.mkVariable tLocale 140001 310017 3 0 "defaultTimeLocale" Prelude.False++(+##=$#=##=$$==) = T.mkVariable tLocale 110021 110022 3 2 "==" Prelude.False++a11v25v11v27compare =+  T.mkVariable tLocale 110025 110027 3 2 "compare" Prelude.False++a11v30v11v33showsPrec =+  T.mkVariable tLocale 110030 110033 3 2 "showsPrec" Prelude.False++a11v25v11v27localFromEnum =+  T.mkVariable tLocale 110025 110027 3 1 "localFromEnum" Prelude.True
+ Hat/Maybe.hs view
@@ -0,0 +1,128 @@+module Hat.Maybe+  (gisJust,aisJust,hisJust,gisNothing,gfromJust,afromJust,hfromJust,gfromMaybe+    ,afromMaybe,hfromMaybe,glistToMaybe,alistToMaybe,hlistToMaybe,gmaybeToList+    ,amaybeToList,hmaybeToList,gcatMaybes,acatMaybes,hcatMaybes,gmapMaybe+    ,amapMaybe,hmapMaybe,Maybe(Nothing,Just),aNothing,aJust,gmaybe,amaybe+    ,hmaybe) where++import qualified Hat.PreludeBasic +import qualified Prelude +import Hat.Hack +import qualified Hat.Hat as T +import Hat.Hat  (WrapVal(wrapVal))+import Hat.Prelude ++gisJust :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun (Maybe a) Bool)++hisJust :: (T.R (Maybe a)) -> T.RefExp -> T.R Bool++gisJust pisJust p = T.ufun1 aisJust pisJust p hisJust++hisJust (T.R (Just fa) _) p = T.con0 T.mkNoSrcPos p True aTrue+hisJust (T.R Nothing _) p = T.con0 T.mkNoSrcPos p False aFalse+hisJust _ p = T.fatal p++gisNothing :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun (Maybe a) Bool)++sisNothing :: T.R (T.Fun (Maybe a) Bool)++gisNothing pisNothing p = T.uconstUse pisNothing p sisNothing++sisNothing =+  T.uconstDef T.mkRoot aisNothing+    (\ p ->+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !. p) (gnot T.mkNoSrcPos p)+        (gisJust T.mkNoSrcPos p))++gfromJust :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun (Maybe a) a)++hfromJust :: (T.R (Maybe a)) -> T.RefExp -> T.R a++gfromJust pfromJust p = T.ufun1 afromJust pfromJust p hfromJust++hfromJust (T.R (Just fa) _) p = T.projection T.mkNoSrcPos p fa+hfromJust (T.R Nothing _) p =+  T.uwrapForward p+    (herror (T.fromLitString T.mkNoSrcPos p "Maybe.fromJust: Nothing") p)+hfromJust _ p = T.fatal p++gfromMaybe :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun a (T.Fun (Maybe a) a))++hfromMaybe :: (T.R a) -> (T.R (Maybe a)) -> T.RefExp -> T.R a++gfromMaybe pfromMaybe p = T.ufun2 afromMaybe pfromMaybe p hfromMaybe++hfromMaybe fd (T.R Nothing _) p = T.projection T.mkNoSrcPos p fd+hfromMaybe fd (T.R (Just fa) _) p = T.projection T.mkNoSrcPos p fa+hfromMaybe _ _ p = T.fatal p++gmaybeToList :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun (Maybe a) (T.List a))++hmaybeToList :: (T.R (Maybe a)) -> T.RefExp -> T.R (T.List a)++gmaybeToList pmaybeToList p = T.ufun1 amaybeToList pmaybeToList p hmaybeToList++hmaybeToList (T.R Nothing _) p = T.con0 T.mkNoSrcPos p T.List T.aList+hmaybeToList (T.R (Just fa) _) p = T.fromExpList T.mkNoSrcPos p [fa]+hmaybeToList _ p = T.fatal p++glistToMaybe :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun (T.List a) (Maybe a))++hlistToMaybe :: (T.R (T.List a)) -> T.RefExp -> T.R (Maybe a)++glistToMaybe plistToMaybe p = T.ufun1 alistToMaybe plistToMaybe p hlistToMaybe++hlistToMaybe (T.R T.List _) p = T.con0 T.mkNoSrcPos p Nothing aNothing+hlistToMaybe (T.R (T.Cons fa _) _) p = T.con1 T.mkNoSrcPos p Just aJust fa+hlistToMaybe _ p = T.fatal p++gcatMaybes ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun (T.List (Maybe a)) (T.List a))++hcatMaybes :: (T.R (T.List (Maybe a))) -> T.RefExp -> T.R (T.List a)++gcatMaybes pcatMaybes p = T.ufun1 acatMaybes pcatMaybes p hcatMaybes++hcatMaybes fms p =+  T.uap1 T.mkNoSrcPos p+    (T.uap2 T.mkNoSrcPos p (Hat.Prelude.g_foldr T.mkNoSrcPos p)+      (T.ufun2 T.mkLambda T.mkNoSrcPos p+        (\ f_x f_y p ->+          T.uccase T.mkNoSrcPos p+            (let+              v0v0v0v0v1 (T.R (Just fm) _) p =+                T.uap1 T.mkNoSrcPos p+                  (T.pa1 T.Cons T.cn1 T.mkNoSrcPos p T.aCons fm) f_y+              v0v0v0v0v1 _ p = T.projection T.mkNoSrcPos p f_y in (v0v0v0v0v1))+            f_x)) fms) (T.fromExpList T.mkNoSrcPos p [])++gmapMaybe ::+  T.RefSrcPos ->+    T.RefExp -> T.R (T.Fun (T.Fun a (Maybe b)) (T.Fun (T.List a) (T.List b)))++hmapMaybe ::+  (T.R (T.Fun a (Maybe b))) -> T.RefExp -> T.R (T.Fun (T.List a) (T.List b))++gmapMaybe pmapMaybe p = T.ufun1 amapMaybe pmapMaybe p hmapMaybe++hmapMaybe ff p =+  T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !. p) (gcatMaybes T.mkNoSrcPos p)+    (T.uap1 T.mkNoSrcPos p (gmap T.mkNoSrcPos p) ff)++tMaybe = T.mkModule "Maybe" "Maybe.hs" Prelude.False++aisJust = T.mkVariable tMaybe 120001 130031 3 1 "isJust" Prelude.False++aisNothing = T.mkVariable tMaybe 160001 160032 3 0 "isNothing" Prelude.False++afromJust = T.mkVariable tMaybe 190001 200057 3 1 "fromJust" Prelude.False++afromMaybe = T.mkVariable tMaybe 230001 240027 3 2 "fromMaybe" Prelude.False++amaybeToList = T.mkVariable tMaybe 270001 280029 3 1 "maybeToList" Prelude.False++alistToMaybe = T.mkVariable tMaybe 310001 320032 3 1 "listToMaybe" Prelude.False++acatMaybes = T.mkVariable tMaybe 350001 350009 3 1 "catMaybes" Prelude.False++amapMaybe = T.mkVariable tMaybe 380001 380043 3 1 "mapMaybe" Prelude.False
+ Hat/Monad.hs view
@@ -0,0 +1,433 @@+module Hat.Monad+  (MonadPlus(gmzero,gmplus,smzero,smplus),gjoin,ajoin,hjoin,gguard,aguard,hguard+    ,gwhen,awhen,hwhen,gunless,aunless,hunless,gap,gmsum,amsum,hmsum,gfilterM+    ,afilterM,hfilterM,gmapAndUnzipM,amapAndUnzipM,hmapAndUnzipM,gzipWithM+    ,azipWithM,hzipWithM,gzipWithM_,azipWithM_,hzipWithM_,gfoldM,afoldM,hfoldM+    ,gliftM,aliftM,hliftM,gliftM2,aliftM2,hliftM2,gliftM3,aliftM3,hliftM3+    ,gliftM4,aliftM4,hliftM4,gliftM5,aliftM5,hliftM5,Monad((!>>=),(!>>),greturn+      ,gfail,(|>>=),(|>>),sreturn,sfail),Functor(gfmap,sfmap),gmapM,amapM,hmapM+    ,gmapM_,amapM_,hmapM_,gsequence,gsequence_,(!=<<),(+=<<),(*=<<)) where++import qualified Hat.PreludeBasic +import qualified Prelude +import Hat.Hack +import qualified Hat.Hat as T +import Hat.Hat  (WrapVal(wrapVal))+import Hat.Prelude ++class Monad m => MonadPlus m+  where+  +  gmzero :: T.RefSrcPos -> T.RefExp -> T.R (m a)+  +  gmplus :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun (m a) (T.Fun (m a) (m a)))+  +  smzero :: T.R (m a)+  +  smplus :: T.R (T.Fun (m a) (T.Fun (m a) (m a)))+  ++instance MonadPlus (Maybe)+  where+  +  gmzero pmzero p = T.uconstUse pmzero p smzero+  +  smzero =+    T.uconstDef T.mkRoot a25v5v25v35mzero+      (\ p -> T.con0 T.mkNoSrcPos p Nothing aNothing)+  +  gmplus pmplus p =+    T.ufun2 a27v14v28v18mplus pmplus p hmplus+    where+    +    hmplus (T.R Nothing _) fys p = T.projection T.mkNoSrcPos p fys+    hmplus fxs fys p = T.projection T.mkNoSrcPos p fxs+    +  ++instance MonadPlus (T.List)+  where+  +  gmzero pmzero p = T.uconstUse pmzero p smzero+  +  smzero =+    T.uconstDef T.mkRoot a31v5v31v15mzero+      (\ p -> T.con0 T.mkNoSrcPos p T.List T.aList)+  +  gmplus pmplus p = T.uconstUse pmplus p smplus+  +  smplus = T.uconstDef T.mkRoot a32v5v32v15mplus (\ p -> (T.mkNoSrcPos !++ p))+  ++gmsum ::+  MonadPlus m => T.RefSrcPos -> T.RefExp -> T.R (T.Fun (T.List (m a)) (m a))++hmsum :: MonadPlus m => (T.R (T.List (m a))) -> T.RefExp -> T.R (m a)++gmsum pmsum p = T.ufun1 amsum pmsum p hmsum++hmsum fxs p =+  T.uwrapForward p+    (hfoldr (gmplus T.mkNoSrcPos p) (gmzero T.mkNoSrcPos p) fxs p)++gjoin :: Monad m => T.RefSrcPos -> T.RefExp -> T.R (T.Fun (m (m a)) (m a))++hjoin :: Monad m => (T.R (m (m a))) -> T.RefExp -> T.R (m a)++gjoin pjoin p = T.ufun1 ajoin pjoin p hjoin++hjoin fx p = T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !>>= p) fx (gid T.mkNoSrcPos p)++gwhen ::+  Monad m =>+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Bool (T.Fun (m T.Tuple0) (m T.Tuple0)))++hwhen ::+  Monad m => (T.R Bool) -> (T.R (m T.Tuple0)) -> T.RefExp -> T.R (m T.Tuple0)++gwhen pwhen p = T.ufun2 awhen pwhen p hwhen++hwhen fp fs p =+  T.ucif p fp (T.projection T.mkNoSrcPos p fs)+    (T.uap1 T.mkNoSrcPos p (greturn T.mkNoSrcPos p)+      (T.con0 T.mkNoSrcPos p T.Tuple0 T.aTuple0))++gunless ::+  Monad m =>+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Bool (T.Fun (m T.Tuple0) (m T.Tuple0)))++hunless ::+  Monad m => (T.R Bool) -> (T.R (m T.Tuple0)) -> T.RefExp -> T.R (m T.Tuple0)++gunless punless p = T.ufun2 aunless punless p hunless++hunless fp fs p = T.uwrapForward p (hwhen (T.uwrapForward p (hnot fp p)) fs p)++gap ::+  Monad m =>+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun (m (T.Fun a b)) (T.Fun (m a) (m b)))++sap :: Monad m => T.R (T.Fun (m (T.Fun a b)) (T.Fun (m a) (m b)))++gap pap p = T.uconstUse pap p sap++sap =+  T.uconstDef T.mkRoot aap+    (\ p -> T.uwrapForward p (hliftM2 (T.mkNoSrcPos !$ p) p))++gguard ::+  MonadPlus m => T.RefSrcPos -> T.RefExp -> T.R (T.Fun Bool (m T.Tuple0))++hguard :: MonadPlus m => (T.R Bool) -> T.RefExp -> T.R (m T.Tuple0)++gguard pguard p = T.ufun1 aguard pguard p hguard++hguard fp p =+  T.ucif p fp+    (T.uap1 T.mkNoSrcPos p (greturn T.mkNoSrcPos p)+      (T.con0 T.mkNoSrcPos p T.Tuple0 T.aTuple0)) (gmzero T.mkNoSrcPos p)++gmapAndUnzipM ::+  Monad m =>+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.Fun a (m (T.Tuple2 b c)))+          (T.Fun (T.List a) (m (T.Tuple2 (T.List b) (T.List c)))))++hmapAndUnzipM ::+  Monad m =>+  (T.R (T.Fun a (m (T.Tuple2 b c)))) ->+    (T.R (T.List a)) -> T.RefExp -> T.R (m (T.Tuple2 (T.List b) (T.List c)))++gmapAndUnzipM pmapAndUnzipM p =+  T.ufun2 amapAndUnzipM pmapAndUnzipM p hmapAndUnzipM++hmapAndUnzipM ff fxs p =+  T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !>>= p)+    (T.uap1 T.mkNoSrcPos p (gsequence T.mkNoSrcPos p)+      (T.uwrapForward p (hmap ff fxs p)))+    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !. p) (greturn T.mkNoSrcPos p)+      (gunzip T.mkNoSrcPos p))++gzipWithM ::+  Monad m =>+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.Fun a (T.Fun b (m c)))+          (T.Fun (T.List a) (T.Fun (T.List b) (m (T.List c)))))++hzipWithM ::+  Monad m =>+  (T.R (T.Fun a (T.Fun b (m c)))) ->+    (T.R (T.List a)) -> (T.R (T.List b)) -> T.RefExp -> T.R (m (T.List c))++gzipWithM pzipWithM p = T.ufun3 azipWithM pzipWithM p hzipWithM++hzipWithM ff fxs fys p =+  T.uap1 T.mkNoSrcPos p (gsequence T.mkNoSrcPos p)+    (T.uwrapForward p (hzipWith ff fxs fys p))++gzipWithM_ ::+  Monad m =>+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.Fun a (T.Fun b (m c)))+          (T.Fun (T.List a) (T.Fun (T.List b) (m T.Tuple0))))++hzipWithM_ ::+  Monad m =>+  (T.R (T.Fun a (T.Fun b (m c)))) ->+    (T.R (T.List a)) -> (T.R (T.List b)) -> T.RefExp -> T.R (m T.Tuple0)++gzipWithM_ pzipWithM_ p = T.ufun3 azipWithM_ pzipWithM_ p hzipWithM_++hzipWithM_ ff fxs fys p =+  T.uap1 T.mkNoSrcPos p (gsequence_ T.mkNoSrcPos p)+    (T.uwrapForward p (hzipWith ff fxs fys p))++gfoldM ::+  Monad m =>+  T.RefSrcPos ->+    T.RefExp ->+      T.R (T.Fun (T.Fun a (T.Fun b (m a))) (T.Fun a (T.Fun (T.List b) (m a))))++hfoldM ::+  Monad m =>+  (T.R (T.Fun a (T.Fun b (m a)))) ->+    (T.R a) -> (T.R (T.List b)) -> T.RefExp -> T.R (m a)++gfoldM pfoldM p = T.ufun3 afoldM pfoldM p hfoldM++hfoldM ff fa (T.R T.List _) p =+  T.uap1 T.mkNoSrcPos p (greturn T.mkNoSrcPos p) fa+hfoldM ff fa (T.R (T.Cons fx fxs) _) p =+  T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !>>= p) (T.uap2 T.mkNoSrcPos p ff fa fx)+    (T.ufun1 T.mkLambda T.mkNoSrcPos p+      (\ fy p -> T.uwrapForward p (hfoldM ff fy fxs p)))+hfoldM _ _ _ p = T.fatal p++gfilterM ::+  Monad m =>+  T.RefSrcPos ->+    T.RefExp -> T.R (T.Fun (T.Fun a (m Bool)) (T.Fun (T.List a) (m (T.List a))))++hfilterM ::+  Monad m =>+  (T.R (T.Fun a (m Bool))) -> (T.R (T.List a)) -> T.RefExp -> T.R (m (T.List a))++gfilterM pfilterM p = T.ufun2 afilterM pfilterM p hfilterM++hfilterM fp (T.R T.List _) p =+  T.uap1 T.mkNoSrcPos p (greturn T.mkNoSrcPos p)+    (T.con0 T.mkNoSrcPos p T.List T.aList)+hfilterM fp (T.R (T.Cons fx fxs) _) p =+  T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>>= p)+    (T.uap1 T.mkNoSrcPos p fp fx)+    (T.ufun1 T.mkDoLambda T.mkNoSrcPos p+      (\ fb p ->+        T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>>= p)+          (T.uwrapForward p (hfilterM fp fxs p))+          (T.ufun1 T.mkDoLambda T.mkNoSrcPos p+            (\ fys p ->+              T.uap1 T.mkNoSrcPos p (greturn T.mkNoSrcPos p)+                (T.ucif p fb (T.con2 T.mkNoSrcPos p T.Cons T.aCons fx fys)+                  (T.projection T.mkNoSrcPos p fys))))))+hfilterM _ _ p = T.fatal p++gliftM ::+  Monad m =>+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun (T.Fun a b) (T.Fun (m a) (m b)))++hliftM :: Monad m => (T.R (T.Fun a b)) -> T.RefExp -> T.R (T.Fun (m a) (m b))++gliftM pliftM p = T.ufun1 aliftM pliftM p hliftM++hliftM ff p =+  T.ufun1 T.mkLambda T.mkNoSrcPos p+    (\ fa p ->+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>>= p) fa+        (T.ufun1 T.mkDoLambda T.mkNoSrcPos p+          (\ fa' p ->+            T.uap1 T.mkNoSrcPos p (greturn T.mkNoSrcPos p)+              (T.uap1 T.mkNoSrcPos p ff fa'))))++gliftM2 ::+  Monad m =>+  T.RefSrcPos ->+    T.RefExp ->+      T.R (T.Fun (T.Fun a (T.Fun b c)) (T.Fun (m a) (T.Fun (m b) (m c))))++hliftM2 ::+  Monad m =>+  (T.R (T.Fun a (T.Fun b c))) ->+    T.RefExp -> T.R (T.Fun (m a) (T.Fun (m b) (m c)))++gliftM2 pliftM2 p = T.ufun1 aliftM2 pliftM2 p hliftM2++hliftM2 ff p =+  T.ufun2 T.mkLambda T.mkNoSrcPos p+    (\ fa fb p ->+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>>= p) fa+        (T.ufun1 T.mkDoLambda T.mkNoSrcPos p+          (\ fa' p ->+            T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>>= p) fb+              (T.ufun1 T.mkDoLambda T.mkNoSrcPos p+                (\ fb' p ->+                  T.uap1 T.mkNoSrcPos p (greturn T.mkNoSrcPos p)+                    (T.uap2 T.mkNoSrcPos p ff fa' fb'))))))++gliftM3 ::+  Monad m =>+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.Fun a (T.Fun b (T.Fun c d)))+          (T.Fun (m a) (T.Fun (m b) (T.Fun (m c) (m d)))))++hliftM3 ::+  Monad m =>+  (T.R (T.Fun a (T.Fun b (T.Fun c d)))) ->+    T.RefExp -> T.R (T.Fun (m a) (T.Fun (m b) (T.Fun (m c) (m d))))++gliftM3 pliftM3 p = T.ufun1 aliftM3 pliftM3 p hliftM3++hliftM3 ff p =+  T.ufun3 T.mkLambda T.mkNoSrcPos p+    (\ fa fb fc p ->+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>>= p) fa+        (T.ufun1 T.mkDoLambda T.mkNoSrcPos p+          (\ fa' p ->+            T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>>= p) fb+              (T.ufun1 T.mkDoLambda T.mkNoSrcPos p+                (\ fb' p ->+                  T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>>= p) fc+                    (T.ufun1 T.mkDoLambda T.mkNoSrcPos p+                      (\ fc' p ->+                        T.uap1 T.mkNoSrcPos p (greturn T.mkNoSrcPos p)+                          (T.uap3 T.mkNoSrcPos p ff fa' fb' fc'))))))))++gliftM4 ::+  Monad m =>+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.Fun a (T.Fun b (T.Fun c (T.Fun d e))))+          (T.Fun (m a) (T.Fun (m b) (T.Fun (m c) (T.Fun (m d) (m e))))))++hliftM4 ::+  Monad m =>+  (T.R (T.Fun a (T.Fun b (T.Fun c (T.Fun d e))))) ->+    T.RefExp ->+      T.R (T.Fun (m a) (T.Fun (m b) (T.Fun (m c) (T.Fun (m d) (m e)))))++gliftM4 pliftM4 p = T.ufun1 aliftM4 pliftM4 p hliftM4++hliftM4 ff p =+  T.ufun4 T.mkLambda T.mkNoSrcPos p+    (\ fa fb fc fd p ->+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>>= p) fa+        (T.ufun1 T.mkDoLambda T.mkNoSrcPos p+          (\ fa' p ->+            T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>>= p) fb+              (T.ufun1 T.mkDoLambda T.mkNoSrcPos p+                (\ fb' p ->+                  T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>>= p) fc+                    (T.ufun1 T.mkDoLambda T.mkNoSrcPos p+                      (\ fc' p ->+                        T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>>= p)+                          fd+                          (T.ufun1 T.mkDoLambda T.mkNoSrcPos p+                            (\ fd' p ->+                              T.uap1 T.mkNoSrcPos p (greturn T.mkNoSrcPos p)+                                (T.uap4 T.mkNoSrcPos p ff fa' fb' fc'+                                  fd'))))))))))++gliftM5 ::+  Monad m =>+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.Fun a (T.Fun b (T.Fun c (T.Fun d (T.Fun e f)))))+          (T.Fun (m a)+            (T.Fun (m b) (T.Fun (m c) (T.Fun (m d) (T.Fun (m e) (m f)))))))++hliftM5 ::+  Monad m =>+  (T.R (T.Fun a (T.Fun b (T.Fun c (T.Fun d (T.Fun e f)))))) ->+    T.RefExp ->+      T.R+        (T.Fun (m a)+          (T.Fun (m b) (T.Fun (m c) (T.Fun (m d) (T.Fun (m e) (m f))))))++gliftM5 pliftM5 p = T.ufun1 aliftM5 pliftM5 p hliftM5++hliftM5 ff p =+  T.ufun5 T.mkLambda T.mkNoSrcPos p+    (\ fa fb fc fd fe p ->+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>>= p) fa+        (T.ufun1 T.mkDoLambda T.mkNoSrcPos p+          (\ fa' p ->+            T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>>= p) fb+              (T.ufun1 T.mkDoLambda T.mkNoSrcPos p+                (\ fb' p ->+                  T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>>= p) fc+                    (T.ufun1 T.mkDoLambda T.mkNoSrcPos p+                      (\ fc' p ->+                        T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>>= p)+                          fd+                          (T.ufun1 T.mkDoLambda T.mkNoSrcPos p+                            (\ fd' p ->+                              T.uap2 T.mkNoSrcPos p+                                (T.mkNoSrcPos Hat.Prelude.!>>= p) fe+                                (T.ufun1 T.mkDoLambda T.mkNoSrcPos p+                                  (\ fe' p ->+                                    T.uap1 T.mkNoSrcPos p+                                      (greturn T.mkNoSrcPos p)+                                      (T.uap5 T.mkNoSrcPos p ff fa' fb' fc' fd'+                                        fe'))))))))))))++tMonad = T.mkModule "Monad" "Monad.hs" Prelude.False++amsum = T.mkVariable tMonad 390001 390032 3 1 "msum" Prelude.False++ajoin = T.mkVariable tMonad 420001 420028 3 1 "join" Prelude.False++awhen = T.mkVariable tMonad 450001 450047 3 2 "when" Prelude.False++aunless = T.mkVariable tMonad 480001 480034 3 2 "unless" Prelude.False++aap = T.mkVariable tMonad 510001 510029 3 0 "ap" Prelude.False++aguard = T.mkVariable tMonad 540001 540051 3 1 "guard" Prelude.False++amapAndUnzipM =+  T.mkVariable tMonad 570001 570058 3 2 "mapAndUnzipM" Prelude.False++azipWithM = T.mkVariable tMonad 600001 600045 3 3 "zipWithM" Prelude.False++azipWithM_ = T.mkVariable tMonad 630001 630047 3 3 "zipWithM_" Prelude.False++afoldM = T.mkVariable tMonad 660001 670049 3 3 "foldM" Prelude.False++afilterM = T.mkVariable tMonad 700001 730032 3 2 "filterM" Prelude.False++aliftM = T.mkVariable tMonad 770001 770052 3 1 "liftM" Prelude.False++aliftM2 = T.mkVariable tMonad 800001 800066 3 1 "liftM2" Prelude.False++aliftM3 = T.mkVariable tMonad 840001 850021 3 1 "liftM3" Prelude.False++aliftM4 = T.mkVariable tMonad 890001 900026 3 1 "liftM4" Prelude.False++aliftM5 = T.mkVariable tMonad 940001 950040 3 1 "liftM5" Prelude.False++a25v5v25v35mzero = T.mkVariable tMonad 250005 250035 3 0 "mzero" Prelude.False++a27v14v28v18mplus = T.mkVariable tMonad 270014 280018 3 2 "mplus" Prelude.False++a31v5v31v15mzero = T.mkVariable tMonad 310005 310015 3 0 "mzero" Prelude.False++a32v5v32v15mplus = T.mkVariable tMonad 320005 320015 3 0 "mplus" Prelude.False
+ Hat/Numeric.hs view
@@ -0,0 +1,18 @@+module Hat.Numeric+  (gfromRat,afromRat,hfromRat,gshowSigned,ashowSigned,hshowSigned,gshowIntAtBase+    ,ashowIntAtBase,hshowIntAtBase,gshowInt,gshowOct,gshowHex,greadSigned+    ,areadSigned,hreadSigned,greadInt,areadInt,hreadInt,greadDec,greadOct+    ,greadHex,gfloatToDigits,afloatToDigits,hfloatToDigits,gshowEFloat+    ,ashowEFloat,hshowEFloat,gshowFFloat,ashowFFloat,hshowFFloat,gshowGFloat+    ,ashowGFloat,hshowGFloat,gshowFloat,greadFloat,areadFloat,hreadFloat+    ,glexDigits) where++import qualified Hat.PreludeBasic +import qualified Prelude +import Hat.Hack +import qualified Hat.Hat as T +import Hat.Hat  (WrapVal(wrapVal))+import Hat.Prelude +import Hat.PreludeBasic ++tNumeric = T.mkModule "Numeric" "Numeric.hs" Prelude.False
+ Hat/Prelude.hs view
@@ -0,0 +1,65 @@+module Hat.Prelude+  (g_filter,a_filter,h_filter,g_foldr,a_foldr,h_foldr,gmap,amap,hmap,(!++),(+++)+    ,(*++),gfilter,afilter,hfilter,gconcat,aconcat,hconcat,ghead,ahead,hhead+    ,glast,alast,hlast,gtail,atail,htail,ginit,ainit,hinit,gnull,anull,hnull+    ,glength,alength,hlength,(!!!),(+!!),(*!!),gfoldl,afoldl,hfoldl,gfoldl1+    ,afoldl1,hfoldl1,gscanl,ascanl,hscanl,gscanl1,ascanl1,hscanl1,gfoldr,afoldr+    ,hfoldr,gfoldr1,afoldr1,hfoldr1,gscanr,ascanr,hscanr,gscanr1,ascanr1,hscanr1+    ,giterate,aiterate,hiterate,grepeat,arepeat,hrepeat,greplicate,areplicate+    ,hreplicate,gcycle,acycle,hcycle,gtake,atake,htake,gdrop,adrop,hdrop+    ,gsplitAt,asplitAt,hsplitAt,gtakeWhile,atakeWhile,htakeWhile,gdropWhile+    ,adropWhile,hdropWhile,gspan,aspan,hspan,gbreak,abreak,hbreak,glines,alines+    ,hlines,gwords,awords,hwords,gunlines,gunwords,aunwords,hunwords,greverse+    ,gand,gor,gany,aany,hany,gall,aall,hall,gelem,aelem,helem,gnotElem,anotElem+    ,hnotElem,glookup,alookup,hlookup,gsum,gproduct,gmaximum,amaximum,hmaximum+    ,gminimum,aminimum,hminimum,gconcatMap,aconcatMap,hconcatMap,gzip,gzip3+    ,gzipWith,azipWith,hzipWith,gzipWith3,azipWith3,hzipWith3,gunzip,gunzip3+    ,ReadS(),ReadS___1(),ReadS___2(),ShowS(),ShowS___1(),ShowS___2()+    ,Read(greadsPrec,greadList,sreadsPrec,sreadList),Show(gshowsPrec,gshow+      ,gshowList,sshowsPrec,sshow,sshowList),greads,gshows,gread,aread,hread+    ,glex,alex,hlex,gshowChar,gshowString,greadParen,areadParen,hreadParen+    ,gshowParen,ashowParen,hshowParen,FilePath(),IOError(),gioError,aioError+    ,hioError,guserError,auserError,huserError,gcatch,acatch,hcatch,gputChar+    ,aputChar,hputChar,gputStr,aputStr,hputStr,gputStrLn,aputStrLn,hputStrLn+    ,gprint,aprint,hprint,ggetChar,ggetLine,ggetContents,ginteract,ainteract+    ,hinteract,greadFile,areadFile,hreadFile,gwriteFile,awriteFile,hwriteFile+    ,gappendFile,aappendFile,happendFile,greadIO,areadIO,hreadIO,greadLn+    ,Bool(False,True),aFalse,aTrue,Maybe(Nothing,Just),aNothing,aJust+    ,Either(Left,Right),aLeft,aRight,Ordering(LT,EQ,GT),aLT,aEQ,aGT,Char()+    ,String(),Int(),Integer(),Float(),Double(),Rational(),IO(),Eq((!==),(!/=)+      ,(|==),(|/=)),Ord(gcompare,(!<),(!<=),(!>=),(!>),gmax,gmin,scompare,(|<)+      ,(|<=),(|>=),(|>),smax,smin),Enum(gsucc,gpred,gtoEnum,gfromEnum,genumFrom+      ,genumFromThen,genumFromTo,genumFromThenTo,ssucc,spred,stoEnum,sfromEnum+      ,senumFrom,senumFromThen,senumFromTo,senumFromThenTo),Bounded(gminBound+      ,gmaxBound,sminBound,smaxBound),Num((!+),(!-),(!*),gnegate,gabs,gsignum+      ,gfromInteger,(|+),(|-),(|*),snegate,sabs,ssignum,sfromInteger)+    ,Real(gtoRational,stoRational),Integral(gquot,grem,gdiv,gmod,gquotRem+      ,gdivMod,gtoInteger,squot,srem,sdiv,smod,squotRem,sdivMod,stoInteger)+    ,Fractional((!/),grecip,gfromRational,(|/),srecip,sfromRational)+    ,Floating(gpi,gexp,glog,gsqrt,(!**),glogBase,gsin,gcos,gtan,gasin,gacos+      ,gatan,gsinh,gcosh,gtanh,gasinh,gacosh,gatanh,spi,sexp,slog,ssqrt,(|**)+      ,slogBase,ssin,scos,stan,sasin,sacos,satan,ssinh,scosh,stanh,sasinh,sacosh+      ,satanh),RealFrac(gproperFraction,gtruncate,ground,gceiling,gfloor+      ,sproperFraction,struncate,sround,sceiling,sfloor),RealFloat(gfloatRadix+      ,gfloatDigits,gfloatRange,gdecodeFloat,gencodeFloat,gexponent,gsignificand+      ,gscaleFloat,gisNaN,gisInfinite,gisDenormalized,gisIEEE,gisNegativeZero+      ,gatan2,sfloatRadix,sfloatDigits,sfloatRange,sdecodeFloat,sencodeFloat+      ,sexponent,ssignificand,sscaleFloat,sisNaN,sisInfinite,sisDenormalized+      ,sisIEEE,sisNegativeZero,satan2),Monad((!>>=),(!>>),greturn,gfail,(|>>=)+      ,(|>>),sreturn,sfail),Functor(gfmap,sfmap),gmapM,amapM,hmapM,gmapM_,amapM_+    ,hmapM_,gsequence,gsequence_,(!=<<),(+=<<),(*=<<),gmaybe,amaybe,hmaybe+    ,geither,aeither,heither,(!&&),(+&&),(*&&),(!||),(+||),(*||),gnot,anot,hnot+    ,gotherwise,gsubtract,geven,aeven,heven,godd,ggcd,agcd,hgcd,glcm,alcm,hlcm+    ,(!^),(+^),(*^),(!^^),(+^^),(*^^),gfromIntegral,grealToFrac,gfst,afst,hfst+    ,gsnd,asnd,hsnd,gcurry,acurry,hcurry,guncurry,auncurry,huncurry,gid,aid,hid+    ,gconst,aconst,hconst,(!.),(+.),(*.),gflip,aflip,hflip,(!$),(+$),(*$),guntil+    ,auntil,huntil,gasTypeOf,gerror,aerror,herror,gundefined,gseq,aseq,hseq+    ,(!$!),(+$!),(*$!)) where++import qualified Prelude +import Hat.Hack +import qualified Hat.Hat as T +import Hat.Hat  (WrapVal(wrapVal))+import Hat.PreludeBasic ++tPrelude = T.mkModule "Prelude" "Prelude.hs" Prelude.False
+ Hat/PreludeBasic.hs view

file too large to diff

+ Hat/PreludeBuiltin.hs view
@@ -0,0 +1,1733 @@+module Hat.PreludeBuiltin+  (T.Fun(),Bool(True,False),aTrue,aFalse,Char(),Int(),Integer(),Float(),Double()+    ,IOError(),T.List(T.Cons,T.List),T.aCons,T.aList,IO(),T.Tuple0(T.Tuple0)+    ,T.aTuple0,T.Tuple2(T.Tuple2),T.aTuple2,T.Tuple3(T.Tuple3),T.aTuple3+    ,T.Tuple4(T.Tuple4),T.aTuple4,T.Tuple5(T.Tuple5),T.aTuple5+    ,T.Tuple6(T.Tuple6),T.aTuple6,T.Tuple7(T.Tuple7),T.aTuple7+    ,T.Tuple8(T.Tuple8),T.aTuple8,T.Tuple9(T.Tuple9),T.aTuple9+    ,T.Tuple10(T.Tuple10),T.aTuple10,T.Tuple11(T.Tuple11),T.aTuple11+    ,T.Tuple12(T.Tuple12),T.aTuple12,T.Tuple13(T.Tuple13),T.aTuple13+    ,T.Tuple14(T.Tuple14),T.aTuple14,T.Tuple15(T.Tuple15),T.aTuple15,String()+    ,gerror,aerror,herror,gundefined,gseq,aseq,hseq,gisAscii,aisAscii,hisAscii+    ,gisLatin1,aisLatin1,hisLatin1,gisControl,aisControl,hisControl,gisPrint+    ,aisPrint,hisPrint,gisSpace,aisSpace,hisSpace,gisUpper,aisUpper,hisUpper+    ,gisLower,aisLower,hisLower,gisAlpha,aisAlpha,hisAlpha,gisDigit,aisDigit+    ,hisDigit,gisOctDigit,aisOctDigit,hisOctDigit,gisHexDigit,aisHexDigit+    ,hisHexDigit,gisAlphaNum,aisAlphaNum,hisAlphaNum,gtoUpper,atoUpper,htoUpper+    ,gtoLower,atoLower,htoLower,gprimIntToChar,aprimIntToChar,hprimIntToChar+    ,gprimCharToInt,aprimCharToInt,hprimCharToInt,gprimUnicodeMaxBound+    ,gprimIntMinBound,gprimIntMaxBound,gprimIntEq,aprimIntEq,hprimIntEq+    ,gprimIntNe,aprimIntNe,hprimIntNe,gprimIntLt,aprimIntLt,hprimIntLt+    ,gprimIntLe,aprimIntLe,hprimIntLe,gprimIntGt,aprimIntGt,hprimIntGt+    ,gprimIntGe,aprimIntGe,hprimIntGe,gprimIntQuot,aprimIntQuot,hprimIntQuot+    ,gprimIntRem,aprimIntRem,hprimIntRem,gprimIntPlus,aprimIntPlus,hprimIntPlus+    ,gprimIntMinus,aprimIntMinus,hprimIntMinus,gprimIntTimes,aprimIntTimes+    ,hprimIntTimes,gprimIntNegate,aprimIntNegate,hprimIntNegate,gprimIntAbs+    ,aprimIntAbs,hprimIntAbs,gprimIntSignum,aprimIntSignum,hprimIntSignum+    ,gprimIntegerFromInt,aprimIntegerFromInt,hprimIntegerFromInt+    ,gprimIntFromInteger,aprimIntFromInteger,hprimIntFromInteger,gprimIntegerEq+    ,aprimIntegerEq,hprimIntegerEq,gprimIntegerNe,aprimIntegerNe,hprimIntegerNe+    ,gprimIntegerLt,aprimIntegerLt,hprimIntegerLt,gprimIntegerLe,aprimIntegerLe+    ,hprimIntegerLe,gprimIntegerGt,aprimIntegerGt,hprimIntegerGt,gprimIntegerGe+    ,aprimIntegerGe,hprimIntegerGe,gprimIntegerQuot,aprimIntegerQuot+    ,hprimIntegerQuot,gprimIntegerRem,aprimIntegerRem,hprimIntegerRem+    ,gprimIntegerQuotRem,aprimIntegerQuotRem,hprimIntegerQuotRem,gprimIntegerAdd+    ,aprimIntegerAdd,hprimIntegerAdd,gprimIntegerSub,aprimIntegerSub+    ,hprimIntegerSub,gprimIntegerMul,aprimIntegerMul,hprimIntegerMul+    ,gprimIntegerNeg,aprimIntegerNeg,hprimIntegerNeg,gprimFloatFromInteger+    ,aprimFloatFromInteger,hprimFloatFromInteger,gprimFloatRadix,aprimFloatRadix+    ,hprimFloatRadix,gprimFloatDigits,aprimFloatDigits,hprimFloatDigits+    ,gprimFloatRange,aprimFloatRange,hprimFloatRange,gprimDecodeFloat+    ,aprimDecodeFloat,hprimDecodeFloat,gprimEncodeFloat,aprimEncodeFloat+    ,hprimEncodeFloat,gprimFloatIsNaN,aprimFloatIsNaN,hprimFloatIsNaN+    ,gprimFloatIsInfinite,aprimFloatIsInfinite,hprimFloatIsInfinite+    ,gprimFloatIsDenormalized,aprimFloatIsDenormalized,hprimFloatIsDenormalized+    ,gprimFloatIsNegativeZero,aprimFloatIsNegativeZero,hprimFloatIsNegativeZero+    ,gprimFloatIsIEEE,aprimFloatIsIEEE,hprimFloatIsIEEE,gprimFloatEq+    ,aprimFloatEq,hprimFloatEq,gprimFloatNe,aprimFloatNe,hprimFloatNe+    ,gprimFloatLt,aprimFloatLt,hprimFloatLt,gprimFloatLe,aprimFloatLe+    ,hprimFloatLe,gprimFloatGt,aprimFloatGt,hprimFloatGt,gprimFloatGe+    ,aprimFloatGe,hprimFloatGe,gprimFloatPi,gprimFloatExp,aprimFloatExp+    ,hprimFloatExp,gprimFloatLog,aprimFloatLog,hprimFloatLog,gprimFloatSqrt+    ,aprimFloatSqrt,hprimFloatSqrt,gprimFloatSin,aprimFloatSin,hprimFloatSin+    ,gprimFloatCos,aprimFloatCos,hprimFloatCos,gprimFloatTan,aprimFloatTan+    ,hprimFloatTan,gprimFloatAsin,aprimFloatAsin,hprimFloatAsin,gprimFloatAcos+    ,aprimFloatAcos,hprimFloatAcos,gprimFloatAtan,aprimFloatAtan,hprimFloatAtan+    ,gprimFloatDiv,aprimFloatDiv,hprimFloatDiv,gprimFloatAdd,aprimFloatAdd+    ,hprimFloatAdd,gprimFloatSub,aprimFloatSub,hprimFloatSub,gprimFloatMul+    ,aprimFloatMul,hprimFloatMul,gprimFloatAbs,aprimFloatAbs,hprimFloatAbs+    ,gprimFloatSignum,aprimFloatSignum,hprimFloatSignum,gprimDoubleFromInteger+    ,aprimDoubleFromInteger,hprimDoubleFromInteger,gprimDoubleRadix+    ,aprimDoubleRadix,hprimDoubleRadix,gprimDoubleDigits,aprimDoubleDigits+    ,hprimDoubleDigits,gprimDoubleRange,aprimDoubleRange,hprimDoubleRange+    ,gprimDecodeDouble,aprimDecodeDouble,hprimDecodeDouble,gprimEncodeDouble+    ,aprimEncodeDouble,hprimEncodeDouble,gprimDoubleIsNaN,aprimDoubleIsNaN+    ,hprimDoubleIsNaN,gprimDoubleIsInfinite,aprimDoubleIsInfinite+    ,hprimDoubleIsInfinite,gprimDoubleIsDenormalized,aprimDoubleIsDenormalized+    ,hprimDoubleIsDenormalized,gprimDoubleIsNegativeZero+    ,aprimDoubleIsNegativeZero,hprimDoubleIsNegativeZero,gprimDoubleIsIEEE+    ,aprimDoubleIsIEEE,hprimDoubleIsIEEE,gprimDoubleEq,aprimDoubleEq+    ,hprimDoubleEq,gprimDoubleNe,aprimDoubleNe,hprimDoubleNe,gprimDoubleLt+    ,aprimDoubleLt,hprimDoubleLt,gprimDoubleLe,aprimDoubleLe,hprimDoubleLe+    ,gprimDoubleGt,aprimDoubleGt,hprimDoubleGt,gprimDoubleGe,aprimDoubleGe+    ,hprimDoubleGe,gprimDoublePi,gprimDoubleExp,aprimDoubleExp,hprimDoubleExp+    ,gprimDoubleLog,aprimDoubleLog,hprimDoubleLog,gprimDoubleSqrt+    ,aprimDoubleSqrt,hprimDoubleSqrt,gprimDoubleSin,aprimDoubleSin+    ,hprimDoubleSin,gprimDoubleCos,aprimDoubleCos,hprimDoubleCos,gprimDoubleTan+    ,aprimDoubleTan,hprimDoubleTan,gprimDoubleAsin,aprimDoubleAsin+    ,hprimDoubleAsin,gprimDoubleAcos,aprimDoubleAcos,hprimDoubleAcos+    ,gprimDoubleAtan,aprimDoubleAtan,hprimDoubleAtan,gprimDoubleDiv+    ,aprimDoubleDiv,hprimDoubleDiv,gprimDoubleAdd,aprimDoubleAdd,hprimDoubleAdd+    ,gprimDoubleSub,aprimDoubleSub,hprimDoubleSub,gprimDoubleMul,aprimDoubleMul+    ,hprimDoubleMul,gprimDoubleAbs,aprimDoubleAbs,hprimDoubleAbs+    ,gprimDoubleSignum,aprimDoubleSignum,hprimDoubleSignum,gprimIOBind+    ,aprimIOBind,hprimIOBind,gprimIOReturn,aprimIOReturn,hprimIOReturn,gioError+    ,aioError,hioError,guserError,auserError,huserError,gcatch,acatch,hcatch+    ,gputChar,aputChar,hputChar,ggetChar,ggetContents,greadFile,areadFile+    ,hreadFile,gwriteFile,awriteFile,hwriteFile,gappendFile,aappendFile+    ,happendFile,gprimIOErrorShow,aprimIOErrorShow,hprimIOErrorShow) where++import qualified Prelude +import Hat.Hack +import qualified Hat.Hat as T +import Hat.Hat  (WrapVal(wrapVal))+import Hat.PreludeBuiltinTypes +import Hat.Hat +import qualified Prelude +import qualified Data.Char as Char ++gseq :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun a (T.Fun b b))++gseq pseq p = T.ufun2 aseq pseq p hseq++hseq z1seq z2seq kseq =+  T.fromId kseq (Prelude.seq (T.toId kseq z1seq) (T.toId kseq z2seq))++gisAscii :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Char Bool)++gisAscii pisAscii p = T.ufun1 aisAscii pisAscii p hisAscii++hisAscii z1isAscii kisAscii =+  fromBool kisAscii (Char.isAscii (T.toChar kisAscii z1isAscii))++gisLatin1 :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Char Bool)++gisLatin1 pisLatin1 p = T.ufun1 aisLatin1 pisLatin1 p hisLatin1++hisLatin1 z1isLatin1 kisLatin1 =+  fromBool kisLatin1 (Char.isLatin1 (T.toChar kisLatin1 z1isLatin1))++gisControl :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Char Bool)++gisControl pisControl p = T.ufun1 aisControl pisControl p hisControl++hisControl z1isControl kisControl =+  fromBool kisControl (Char.isControl (T.toChar kisControl z1isControl))++gisPrint :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Char Bool)++gisPrint pisPrint p = T.ufun1 aisPrint pisPrint p hisPrint++hisPrint z1isPrint kisPrint =+  fromBool kisPrint (Char.isPrint (T.toChar kisPrint z1isPrint))++gisSpace :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Char Bool)++gisSpace pisSpace p = T.ufun1 aisSpace pisSpace p hisSpace++hisSpace z1isSpace kisSpace =+  fromBool kisSpace (Char.isSpace (T.toChar kisSpace z1isSpace))++gisUpper :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Char Bool)++gisUpper pisUpper p = T.ufun1 aisUpper pisUpper p hisUpper++hisUpper z1isUpper kisUpper =+  fromBool kisUpper (Char.isUpper (T.toChar kisUpper z1isUpper))++gisLower :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Char Bool)++gisLower pisLower p = T.ufun1 aisLower pisLower p hisLower++hisLower z1isLower kisLower =+  fromBool kisLower (Char.isLower (T.toChar kisLower z1isLower))++gisAlpha :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Char Bool)++gisAlpha pisAlpha p = T.ufun1 aisAlpha pisAlpha p hisAlpha++hisAlpha z1isAlpha kisAlpha =+  fromBool kisAlpha (Char.isAlpha (T.toChar kisAlpha z1isAlpha))++gisDigit :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Char Bool)++gisDigit pisDigit p = T.ufun1 aisDigit pisDigit p hisDigit++hisDigit z1isDigit kisDigit =+  fromBool kisDigit (Char.isDigit (T.toChar kisDigit z1isDigit))++gisOctDigit :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Char Bool)++gisOctDigit pisOctDigit p = T.ufun1 aisOctDigit pisOctDigit p hisOctDigit++hisOctDigit z1isOctDigit kisOctDigit =+  fromBool kisOctDigit (Char.isOctDigit (T.toChar kisOctDigit z1isOctDigit))++gisHexDigit :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Char Bool)++gisHexDigit pisHexDigit p = T.ufun1 aisHexDigit pisHexDigit p hisHexDigit++hisHexDigit z1isHexDigit kisHexDigit =+  fromBool kisHexDigit (Char.isHexDigit (T.toChar kisHexDigit z1isHexDigit))++gisAlphaNum :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Char Bool)++gisAlphaNum pisAlphaNum p = T.ufun1 aisAlphaNum pisAlphaNum p hisAlphaNum++hisAlphaNum z1isAlphaNum kisAlphaNum =+  fromBool kisAlphaNum (Char.isAlphaNum (T.toChar kisAlphaNum z1isAlphaNum))++gtoUpper :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Char Char)++gtoUpper ptoUpper p = T.ufun1 atoUpper ptoUpper p htoUpper++htoUpper z1toUpper ktoUpper =+  T.fromChar ktoUpper (Char.toUpper (T.toChar ktoUpper z1toUpper))++gtoLower :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Char Char)++gtoLower ptoLower p = T.ufun1 atoLower ptoLower p htoLower++htoLower z1toLower ktoLower =+  T.fromChar ktoLower (Char.toLower (T.toChar ktoLower z1toLower))++gprimCharToInt :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Char Int)++gprimCharToInt pprimCharToInt p =+  T.ufun1 aprimCharToInt pprimCharToInt p hprimCharToInt++hprimCharToInt z1primCharToInt kprimCharToInt =+  T.fromInt kprimCharToInt (Char.ord (T.toChar kprimCharToInt z1primCharToInt))++gprimIntToChar :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Int Char)++gprimIntToChar pprimIntToChar p =+  T.ufun1 aprimIntToChar pprimIntToChar p hprimIntToChar++hprimIntToChar z1primIntToChar kprimIntToChar =+  T.fromChar kprimIntToChar (Char.chr (T.toInt kprimIntToChar z1primIntToChar))++gprimUnicodeMaxBound :: T.RefSrcPos -> T.RefExp -> T.R Char++gprimUnicodeMaxBound pprimUnicodeMaxBound p =+  T.uconstUse pprimUnicodeMaxBound p sprimUnicodeMaxBound++sprimUnicodeMaxBound =+  T.uconstDef T.mkRoot aprimUnicodeMaxBound+    (\ p -> T.fromChar p Prelude.maxBound)++gprimIntMinBound :: T.RefSrcPos -> T.RefExp -> T.R Int++gprimIntMinBound pprimIntMinBound p =+  T.uconstUse pprimIntMinBound p sprimIntMinBound++sprimIntMinBound =+  T.uconstDef T.mkRoot aprimIntMinBound (\ p -> T.fromInt p Prelude.minBound)++gprimIntMaxBound :: T.RefSrcPos -> T.RefExp -> T.R Int++gprimIntMaxBound pprimIntMaxBound p =+  T.uconstUse pprimIntMaxBound p sprimIntMaxBound++sprimIntMaxBound =+  T.uconstDef T.mkRoot aprimIntMaxBound (\ p -> T.fromInt p Prelude.maxBound)++gprimIntEq :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Int (T.Fun Int Bool))++gprimIntEq pprimIntEq p = T.ufun2 aprimIntEq pprimIntEq p hprimIntEq++hprimIntEq z1primIntEq z2primIntEq kprimIntEq =+  fromBool kprimIntEq+    ((T.toInt kprimIntEq z1primIntEq)+      Prelude.==+      (T.toInt kprimIntEq z2primIntEq))++gprimIntNe :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Int (T.Fun Int Bool))++gprimIntNe pprimIntNe p = T.ufun2 aprimIntNe pprimIntNe p hprimIntNe++hprimIntNe z1primIntNe z2primIntNe kprimIntNe =+  fromBool kprimIntNe+    ((T.toInt kprimIntNe z1primIntNe)+      Prelude./=+      (T.toInt kprimIntNe z2primIntNe))++gprimIntLt :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Int (T.Fun Int Bool))++gprimIntLt pprimIntLt p = T.ufun2 aprimIntLt pprimIntLt p hprimIntLt++hprimIntLt z1primIntLt z2primIntLt kprimIntLt =+  fromBool kprimIntLt+    ((T.toInt kprimIntLt z1primIntLt)+      Prelude.<+      (T.toInt kprimIntLt z2primIntLt))++gprimIntLe :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Int (T.Fun Int Bool))++gprimIntLe pprimIntLe p = T.ufun2 aprimIntLe pprimIntLe p hprimIntLe++hprimIntLe z1primIntLe z2primIntLe kprimIntLe =+  fromBool kprimIntLe+    ((T.toInt kprimIntLe z1primIntLe)+      Prelude.<=+      (T.toInt kprimIntLe z2primIntLe))++gprimIntGt :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Int (T.Fun Int Bool))++gprimIntGt pprimIntGt p = T.ufun2 aprimIntGt pprimIntGt p hprimIntGt++hprimIntGt z1primIntGt z2primIntGt kprimIntGt =+  fromBool kprimIntGt+    ((T.toInt kprimIntGt z1primIntGt)+      Prelude.>+      (T.toInt kprimIntGt z2primIntGt))++gprimIntGe :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Int (T.Fun Int Bool))++gprimIntGe pprimIntGe p = T.ufun2 aprimIntGe pprimIntGe p hprimIntGe++hprimIntGe z1primIntGe z2primIntGe kprimIntGe =+  fromBool kprimIntGe+    ((T.toInt kprimIntGe z1primIntGe)+      Prelude.>=+      (T.toInt kprimIntGe z2primIntGe))++gprimIntQuot :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Int (T.Fun Int Int))++gprimIntQuot pprimIntQuot p = T.ufun2 aprimIntQuot pprimIntQuot p hprimIntQuot++hprimIntQuot z1primIntQuot z2primIntQuot kprimIntQuot =+  T.fromInt kprimIntQuot+    (Prelude.quot (T.toInt kprimIntQuot z1primIntQuot)+      (T.toInt kprimIntQuot z2primIntQuot))++gprimIntRem :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Int (T.Fun Int Int))++gprimIntRem pprimIntRem p = T.ufun2 aprimIntRem pprimIntRem p hprimIntRem++hprimIntRem z1primIntRem z2primIntRem kprimIntRem =+  T.fromInt kprimIntRem+    (Prelude.rem (T.toInt kprimIntRem z1primIntRem)+      (T.toInt kprimIntRem z2primIntRem))++gprimIntPlus :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Int (T.Fun Int Int))++gprimIntPlus pprimIntPlus p = T.ufun2 aprimIntPlus pprimIntPlus p hprimIntPlus++hprimIntPlus z1primIntPlus z2primIntPlus kprimIntPlus =+  T.fromInt kprimIntPlus+    ((T.toInt kprimIntPlus z1primIntPlus)+      Prelude.++      (T.toInt kprimIntPlus z2primIntPlus))++gprimIntMinus :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Int (T.Fun Int Int))++gprimIntMinus pprimIntMinus p =+  T.ufun2 aprimIntMinus pprimIntMinus p hprimIntMinus++hprimIntMinus z1primIntMinus z2primIntMinus kprimIntMinus =+  T.fromInt kprimIntMinus+    ((T.toInt kprimIntMinus z1primIntMinus)+      Prelude.-+      (T.toInt kprimIntMinus z2primIntMinus))++gprimIntTimes :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Int (T.Fun Int Int))++gprimIntTimes pprimIntTimes p =+  T.ufun2 aprimIntTimes pprimIntTimes p hprimIntTimes++hprimIntTimes z1primIntTimes z2primIntTimes kprimIntTimes =+  T.fromInt kprimIntTimes+    ((T.toInt kprimIntTimes z1primIntTimes)+      Prelude.*+      (T.toInt kprimIntTimes z2primIntTimes))++gprimIntNegate :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Int Int)++gprimIntNegate pprimIntNegate p =+  T.ufun1 aprimIntNegate pprimIntNegate p hprimIntNegate++hprimIntNegate z1primIntNegate kprimIntNegate =+  T.fromInt kprimIntNegate+    (Prelude.negate (T.toInt kprimIntNegate z1primIntNegate))++gprimIntAbs :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Int Int)++gprimIntAbs pprimIntAbs p = T.ufun1 aprimIntAbs pprimIntAbs p hprimIntAbs++hprimIntAbs z1primIntAbs kprimIntAbs =+  T.fromInt kprimIntAbs (Prelude.abs (T.toInt kprimIntAbs z1primIntAbs))++gprimIntSignum :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Int Int)++gprimIntSignum pprimIntSignum p =+  T.ufun1 aprimIntSignum pprimIntSignum p hprimIntSignum++hprimIntSignum z1primIntSignum kprimIntSignum =+  T.fromInt kprimIntSignum+    (Prelude.signum (T.toInt kprimIntSignum z1primIntSignum))++gprimIntegerFromInt :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Int Integer)++gprimIntegerFromInt pprimIntegerFromInt p =+  T.ufun1 aprimIntegerFromInt pprimIntegerFromInt p hprimIntegerFromInt++hprimIntegerFromInt z1primIntegerFromInt kprimIntegerFromInt =+  T.fromInteger kprimIntegerFromInt+    (Prelude.toInteger (T.toInt kprimIntegerFromInt z1primIntegerFromInt))++gprimIntFromInteger :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Integer Int)++gprimIntFromInteger pprimIntFromInteger p =+  T.ufun1 aprimIntFromInteger pprimIntFromInteger p hprimIntFromInteger++hprimIntFromInteger z1primIntFromInteger kprimIntFromInteger =+  T.fromInt kprimIntFromInteger+    (Prelude.fromInteger (T.toInteger kprimIntFromInteger z1primIntFromInteger))++gprimIntegerEq ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Integer (T.Fun Integer Bool))++gprimIntegerEq pprimIntegerEq p =+  T.ufun2 aprimIntegerEq pprimIntegerEq p hprimIntegerEq++hprimIntegerEq z1primIntegerEq z2primIntegerEq kprimIntegerEq =+  fromBool kprimIntegerEq+    ((T.toInteger kprimIntegerEq z1primIntegerEq)+      Prelude.==+      (T.toInteger kprimIntegerEq z2primIntegerEq))++gprimIntegerNe ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Integer (T.Fun Integer Bool))++gprimIntegerNe pprimIntegerNe p =+  T.ufun2 aprimIntegerNe pprimIntegerNe p hprimIntegerNe++hprimIntegerNe z1primIntegerNe z2primIntegerNe kprimIntegerNe =+  fromBool kprimIntegerNe+    ((T.toInteger kprimIntegerNe z1primIntegerNe)+      Prelude./=+      (T.toInteger kprimIntegerNe z2primIntegerNe))++gprimIntegerLt ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Integer (T.Fun Integer Bool))++gprimIntegerLt pprimIntegerLt p =+  T.ufun2 aprimIntegerLt pprimIntegerLt p hprimIntegerLt++hprimIntegerLt z1primIntegerLt z2primIntegerLt kprimIntegerLt =+  fromBool kprimIntegerLt+    ((T.toInteger kprimIntegerLt z1primIntegerLt)+      Prelude.<+      (T.toInteger kprimIntegerLt z2primIntegerLt))++gprimIntegerLe ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Integer (T.Fun Integer Bool))++gprimIntegerLe pprimIntegerLe p =+  T.ufun2 aprimIntegerLe pprimIntegerLe p hprimIntegerLe++hprimIntegerLe z1primIntegerLe z2primIntegerLe kprimIntegerLe =+  fromBool kprimIntegerLe+    ((T.toInteger kprimIntegerLe z1primIntegerLe)+      Prelude.<=+      (T.toInteger kprimIntegerLe z2primIntegerLe))++gprimIntegerGt ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Integer (T.Fun Integer Bool))++gprimIntegerGt pprimIntegerGt p =+  T.ufun2 aprimIntegerGt pprimIntegerGt p hprimIntegerGt++hprimIntegerGt z1primIntegerGt z2primIntegerGt kprimIntegerGt =+  fromBool kprimIntegerGt+    ((T.toInteger kprimIntegerGt z1primIntegerGt)+      Prelude.>+      (T.toInteger kprimIntegerGt z2primIntegerGt))++gprimIntegerGe ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Integer (T.Fun Integer Bool))++gprimIntegerGe pprimIntegerGe p =+  T.ufun2 aprimIntegerGe pprimIntegerGe p hprimIntegerGe++hprimIntegerGe z1primIntegerGe z2primIntegerGe kprimIntegerGe =+  fromBool kprimIntegerGe+    ((T.toInteger kprimIntegerGe z1primIntegerGe)+      Prelude.>=+      (T.toInteger kprimIntegerGe z2primIntegerGe))++gprimIntegerQuot ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Integer (T.Fun Integer Integer))++gprimIntegerQuot pprimIntegerQuot p =+  T.ufun2 aprimIntegerQuot pprimIntegerQuot p hprimIntegerQuot++hprimIntegerQuot z1primIntegerQuot z2primIntegerQuot kprimIntegerQuot =+  T.fromInteger kprimIntegerQuot+    (Prelude.quot (T.toInteger kprimIntegerQuot z1primIntegerQuot)+      (T.toInteger kprimIntegerQuot z2primIntegerQuot))++gprimIntegerRem ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Integer (T.Fun Integer Integer))++gprimIntegerRem pprimIntegerRem p =+  T.ufun2 aprimIntegerRem pprimIntegerRem p hprimIntegerRem++hprimIntegerRem z1primIntegerRem z2primIntegerRem kprimIntegerRem =+  T.fromInteger kprimIntegerRem+    (Prelude.rem (T.toInteger kprimIntegerRem z1primIntegerRem)+      (T.toInteger kprimIntegerRem z2primIntegerRem))++gprimIntegerQuotRem ::+  T.RefSrcPos ->+    T.RefExp -> T.R (T.Fun Integer (T.Fun Integer (T.Tuple2 Integer Integer)))++gprimIntegerQuotRem pprimIntegerQuotRem p =+  T.ufun2 aprimIntegerQuotRem pprimIntegerQuotRem p hprimIntegerQuotRem++hprimIntegerQuotRem z1primIntegerQuotRem z2primIntegerQuotRem+  kprimIntegerQuotRem =+  (T.fromTuple2 T.fromInteger T.fromInteger) kprimIntegerQuotRem+    (Prelude.quotRem (T.toInteger kprimIntegerQuotRem z1primIntegerQuotRem)+      (T.toInteger kprimIntegerQuotRem z2primIntegerQuotRem))++gprimIntegerAdd ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Integer (T.Fun Integer Integer))++gprimIntegerAdd pprimIntegerAdd p =+  T.ufun2 aprimIntegerAdd pprimIntegerAdd p hprimIntegerAdd++hprimIntegerAdd z1primIntegerAdd z2primIntegerAdd kprimIntegerAdd =+  T.fromInteger kprimIntegerAdd+    ((T.toInteger kprimIntegerAdd z1primIntegerAdd)+      Prelude.++      (T.toInteger kprimIntegerAdd z2primIntegerAdd))++gprimIntegerSub ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Integer (T.Fun Integer Integer))++gprimIntegerSub pprimIntegerSub p =+  T.ufun2 aprimIntegerSub pprimIntegerSub p hprimIntegerSub++hprimIntegerSub z1primIntegerSub z2primIntegerSub kprimIntegerSub =+  T.fromInteger kprimIntegerSub+    ((T.toInteger kprimIntegerSub z1primIntegerSub)+      Prelude.-+      (T.toInteger kprimIntegerSub z2primIntegerSub))++gprimIntegerMul ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Integer (T.Fun Integer Integer))++gprimIntegerMul pprimIntegerMul p =+  T.ufun2 aprimIntegerMul pprimIntegerMul p hprimIntegerMul++hprimIntegerMul z1primIntegerMul z2primIntegerMul kprimIntegerMul =+  T.fromInteger kprimIntegerMul+    ((T.toInteger kprimIntegerMul z1primIntegerMul)+      Prelude.*+      (T.toInteger kprimIntegerMul z2primIntegerMul))++gprimIntegerNeg :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Integer Integer)++gprimIntegerNeg pprimIntegerNeg p =+  T.ufun1 aprimIntegerNeg pprimIntegerNeg p hprimIntegerNeg++hprimIntegerNeg z1primIntegerNeg kprimIntegerNeg =+  T.fromInteger kprimIntegerNeg+    (Prelude.negate (T.toInteger kprimIntegerNeg z1primIntegerNeg))++gprimFloatFromInteger :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Integer Float)++gprimFloatFromInteger pprimFloatFromInteger p =+  T.ufun1 aprimFloatFromInteger pprimFloatFromInteger p hprimFloatFromInteger++hprimFloatFromInteger z1primFloatFromInteger kprimFloatFromInteger =+  T.fromFloat kprimFloatFromInteger+    (Prelude.fromInteger+      (T.toInteger kprimFloatFromInteger z1primFloatFromInteger))++gprimFloatRadix :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float Integer)++gprimFloatRadix pprimFloatRadix p =+  T.ufun1 aprimFloatRadix pprimFloatRadix p hprimFloatRadix++hprimFloatRadix z1primFloatRadix kprimFloatRadix =+  T.fromInteger kprimFloatRadix+    (Prelude.floatRadix (T.toFloat kprimFloatRadix z1primFloatRadix))++gprimFloatDigits :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float Int)++gprimFloatDigits pprimFloatDigits p =+  T.ufun1 aprimFloatDigits pprimFloatDigits p hprimFloatDigits++hprimFloatDigits z1primFloatDigits kprimFloatDigits =+  T.fromInt kprimFloatDigits+    (Prelude.floatDigits (T.toFloat kprimFloatDigits z1primFloatDigits))++gprimFloatRange ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float (T.Tuple2 Int Int))++gprimFloatRange pprimFloatRange p =+  T.ufun1 aprimFloatRange pprimFloatRange p hprimFloatRange++hprimFloatRange z1primFloatRange kprimFloatRange =+  (T.fromTuple2 T.fromInt T.fromInt) kprimFloatRange+    (Prelude.floatRange (T.toFloat kprimFloatRange z1primFloatRange))++gprimDecodeFloat ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float (T.Tuple2 Integer Int))++gprimDecodeFloat pprimDecodeFloat p =+  T.ufun1 aprimDecodeFloat pprimDecodeFloat p hprimDecodeFloat++hprimDecodeFloat z1primDecodeFloat kprimDecodeFloat =+  (T.fromTuple2 T.fromInteger T.fromInt) kprimDecodeFloat+    (Prelude.decodeFloat (T.toFloat kprimDecodeFloat z1primDecodeFloat))++gprimEncodeFloat ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Integer (T.Fun Int Float))++gprimEncodeFloat pprimEncodeFloat p =+  T.ufun2 aprimEncodeFloat pprimEncodeFloat p hprimEncodeFloat++hprimEncodeFloat z1primEncodeFloat z2primEncodeFloat kprimEncodeFloat =+  T.fromFloat kprimEncodeFloat+    (Prelude.encodeFloat (T.toInteger kprimEncodeFloat z1primEncodeFloat)+      (T.toInt kprimEncodeFloat z2primEncodeFloat))++gprimFloatIsNaN :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float Bool)++gprimFloatIsNaN pprimFloatIsNaN p =+  T.ufun1 aprimFloatIsNaN pprimFloatIsNaN p hprimFloatIsNaN++hprimFloatIsNaN z1primFloatIsNaN kprimFloatIsNaN =+  fromBool kprimFloatIsNaN+    (Prelude.isNaN (T.toFloat kprimFloatIsNaN z1primFloatIsNaN))++gprimFloatIsInfinite :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float Bool)++gprimFloatIsInfinite pprimFloatIsInfinite p =+  T.ufun1 aprimFloatIsInfinite pprimFloatIsInfinite p hprimFloatIsInfinite++hprimFloatIsInfinite z1primFloatIsInfinite kprimFloatIsInfinite =+  fromBool kprimFloatIsInfinite+    (Prelude.isInfinite (T.toFloat kprimFloatIsInfinite z1primFloatIsInfinite))++gprimFloatIsDenormalized :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float Bool)++gprimFloatIsDenormalized pprimFloatIsDenormalized p =+  T.ufun1 aprimFloatIsDenormalized pprimFloatIsDenormalized p+    hprimFloatIsDenormalized++hprimFloatIsDenormalized z1primFloatIsDenormalized kprimFloatIsDenormalized =+  fromBool kprimFloatIsDenormalized+    (Prelude.isDenormalized+      (T.toFloat kprimFloatIsDenormalized z1primFloatIsDenormalized))++gprimFloatIsNegativeZero :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float Bool)++gprimFloatIsNegativeZero pprimFloatIsNegativeZero p =+  T.ufun1 aprimFloatIsNegativeZero pprimFloatIsNegativeZero p+    hprimFloatIsNegativeZero++hprimFloatIsNegativeZero z1primFloatIsNegativeZero kprimFloatIsNegativeZero =+  fromBool kprimFloatIsNegativeZero+    (Prelude.isNegativeZero+      (T.toFloat kprimFloatIsNegativeZero z1primFloatIsNegativeZero))++gprimFloatIsIEEE :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float Bool)++gprimFloatIsIEEE pprimFloatIsIEEE p =+  T.ufun1 aprimFloatIsIEEE pprimFloatIsIEEE p hprimFloatIsIEEE++hprimFloatIsIEEE z1primFloatIsIEEE kprimFloatIsIEEE =+  fromBool kprimFloatIsIEEE+    (Prelude.isIEEE (T.toFloat kprimFloatIsIEEE z1primFloatIsIEEE))++gprimFloatEq :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float (T.Fun Float Bool))++gprimFloatEq pprimFloatEq p = T.ufun2 aprimFloatEq pprimFloatEq p hprimFloatEq++hprimFloatEq z1primFloatEq z2primFloatEq kprimFloatEq =+  fromBool kprimFloatEq+    ((T.toFloat kprimFloatEq z1primFloatEq)+      Prelude.==+      (T.toFloat kprimFloatEq z2primFloatEq))++gprimFloatNe :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float (T.Fun Float Bool))++gprimFloatNe pprimFloatNe p = T.ufun2 aprimFloatNe pprimFloatNe p hprimFloatNe++hprimFloatNe z1primFloatNe z2primFloatNe kprimFloatNe =+  fromBool kprimFloatNe+    ((T.toFloat kprimFloatNe z1primFloatNe)+      Prelude./=+      (T.toFloat kprimFloatNe z2primFloatNe))++gprimFloatLt :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float (T.Fun Float Bool))++gprimFloatLt pprimFloatLt p = T.ufun2 aprimFloatLt pprimFloatLt p hprimFloatLt++hprimFloatLt z1primFloatLt z2primFloatLt kprimFloatLt =+  fromBool kprimFloatLt+    ((T.toFloat kprimFloatLt z1primFloatLt)+      Prelude.<+      (T.toFloat kprimFloatLt z2primFloatLt))++gprimFloatLe :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float (T.Fun Float Bool))++gprimFloatLe pprimFloatLe p = T.ufun2 aprimFloatLe pprimFloatLe p hprimFloatLe++hprimFloatLe z1primFloatLe z2primFloatLe kprimFloatLe =+  fromBool kprimFloatLe+    ((T.toFloat kprimFloatLe z1primFloatLe)+      Prelude.<=+      (T.toFloat kprimFloatLe z2primFloatLe))++gprimFloatGt :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float (T.Fun Float Bool))++gprimFloatGt pprimFloatGt p = T.ufun2 aprimFloatGt pprimFloatGt p hprimFloatGt++hprimFloatGt z1primFloatGt z2primFloatGt kprimFloatGt =+  fromBool kprimFloatGt+    ((T.toFloat kprimFloatGt z1primFloatGt)+      Prelude.>+      (T.toFloat kprimFloatGt z2primFloatGt))++gprimFloatGe :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float (T.Fun Float Bool))++gprimFloatGe pprimFloatGe p = T.ufun2 aprimFloatGe pprimFloatGe p hprimFloatGe++hprimFloatGe z1primFloatGe z2primFloatGe kprimFloatGe =+  fromBool kprimFloatGe+    ((T.toFloat kprimFloatGe z1primFloatGe)+      Prelude.>=+      (T.toFloat kprimFloatGe z2primFloatGe))++gprimFloatPi :: T.RefSrcPos -> T.RefExp -> T.R Float++gprimFloatPi pprimFloatPi p = T.uconstUse pprimFloatPi p sprimFloatPi++sprimFloatPi =+  T.uconstDef T.mkRoot aprimFloatPi (\ p -> T.fromFloat p Prelude.pi)++gprimFloatExp :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float Float)++gprimFloatExp pprimFloatExp p =+  T.ufun1 aprimFloatExp pprimFloatExp p hprimFloatExp++hprimFloatExp z1primFloatExp kprimFloatExp =+  T.fromFloat kprimFloatExp+    (Prelude.exp (T.toFloat kprimFloatExp z1primFloatExp))++gprimFloatLog :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float Float)++gprimFloatLog pprimFloatLog p =+  T.ufun1 aprimFloatLog pprimFloatLog p hprimFloatLog++hprimFloatLog z1primFloatLog kprimFloatLog =+  T.fromFloat kprimFloatLog+    (Prelude.log (T.toFloat kprimFloatLog z1primFloatLog))++gprimFloatSqrt :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float Float)++gprimFloatSqrt pprimFloatSqrt p =+  T.ufun1 aprimFloatSqrt pprimFloatSqrt p hprimFloatSqrt++hprimFloatSqrt z1primFloatSqrt kprimFloatSqrt =+  T.fromFloat kprimFloatSqrt+    (Prelude.sqrt (T.toFloat kprimFloatSqrt z1primFloatSqrt))++gprimFloatSin :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float Float)++gprimFloatSin pprimFloatSin p =+  T.ufun1 aprimFloatSin pprimFloatSin p hprimFloatSin++hprimFloatSin z1primFloatSin kprimFloatSin =+  T.fromFloat kprimFloatSin+    (Prelude.sin (T.toFloat kprimFloatSin z1primFloatSin))++gprimFloatCos :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float Float)++gprimFloatCos pprimFloatCos p =+  T.ufun1 aprimFloatCos pprimFloatCos p hprimFloatCos++hprimFloatCos z1primFloatCos kprimFloatCos =+  T.fromFloat kprimFloatCos+    (Prelude.cos (T.toFloat kprimFloatCos z1primFloatCos))++gprimFloatTan :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float Float)++gprimFloatTan pprimFloatTan p =+  T.ufun1 aprimFloatTan pprimFloatTan p hprimFloatTan++hprimFloatTan z1primFloatTan kprimFloatTan =+  T.fromFloat kprimFloatTan+    (Prelude.tan (T.toFloat kprimFloatTan z1primFloatTan))++gprimFloatAsin :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float Float)++gprimFloatAsin pprimFloatAsin p =+  T.ufun1 aprimFloatAsin pprimFloatAsin p hprimFloatAsin++hprimFloatAsin z1primFloatAsin kprimFloatAsin =+  T.fromFloat kprimFloatAsin+    (Prelude.asin (T.toFloat kprimFloatAsin z1primFloatAsin))++gprimFloatAcos :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float Float)++gprimFloatAcos pprimFloatAcos p =+  T.ufun1 aprimFloatAcos pprimFloatAcos p hprimFloatAcos++hprimFloatAcos z1primFloatAcos kprimFloatAcos =+  T.fromFloat kprimFloatAcos+    (Prelude.acos (T.toFloat kprimFloatAcos z1primFloatAcos))++gprimFloatAtan :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float Float)++gprimFloatAtan pprimFloatAtan p =+  T.ufun1 aprimFloatAtan pprimFloatAtan p hprimFloatAtan++hprimFloatAtan z1primFloatAtan kprimFloatAtan =+  T.fromFloat kprimFloatAtan+    (Prelude.atan (T.toFloat kprimFloatAtan z1primFloatAtan))++gprimFloatDiv ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float (T.Fun Float Float))++gprimFloatDiv pprimFloatDiv p =+  T.ufun2 aprimFloatDiv pprimFloatDiv p hprimFloatDiv++hprimFloatDiv z1primFloatDiv z2primFloatDiv kprimFloatDiv =+  T.fromFloat kprimFloatDiv+    ((T.toFloat kprimFloatDiv z1primFloatDiv)+      Prelude./+      (T.toFloat kprimFloatDiv z2primFloatDiv))++gprimFloatAdd ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float (T.Fun Float Float))++gprimFloatAdd pprimFloatAdd p =+  T.ufun2 aprimFloatAdd pprimFloatAdd p hprimFloatAdd++hprimFloatAdd z1primFloatAdd z2primFloatAdd kprimFloatAdd =+  T.fromFloat kprimFloatAdd+    ((T.toFloat kprimFloatAdd z1primFloatAdd)+      Prelude.++      (T.toFloat kprimFloatAdd z2primFloatAdd))++gprimFloatSub ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float (T.Fun Float Float))++gprimFloatSub pprimFloatSub p =+  T.ufun2 aprimFloatSub pprimFloatSub p hprimFloatSub++hprimFloatSub z1primFloatSub z2primFloatSub kprimFloatSub =+  T.fromFloat kprimFloatSub+    ((T.toFloat kprimFloatSub z1primFloatSub)+      Prelude.-+      (T.toFloat kprimFloatSub z2primFloatSub))++gprimFloatMul ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float (T.Fun Float Float))++gprimFloatMul pprimFloatMul p =+  T.ufun2 aprimFloatMul pprimFloatMul p hprimFloatMul++hprimFloatMul z1primFloatMul z2primFloatMul kprimFloatMul =+  T.fromFloat kprimFloatMul+    ((T.toFloat kprimFloatMul z1primFloatMul)+      Prelude.*+      (T.toFloat kprimFloatMul z2primFloatMul))++gprimFloatAbs :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float Float)++gprimFloatAbs pprimFloatAbs p =+  T.ufun1 aprimFloatAbs pprimFloatAbs p hprimFloatAbs++hprimFloatAbs z1primFloatAbs kprimFloatAbs =+  T.fromFloat kprimFloatAbs+    (Prelude.abs (T.toFloat kprimFloatAbs z1primFloatAbs))++gprimFloatSignum :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Float Float)++gprimFloatSignum pprimFloatSignum p =+  T.ufun1 aprimFloatSignum pprimFloatSignum p hprimFloatSignum++hprimFloatSignum z1primFloatSignum kprimFloatSignum =+  T.fromFloat kprimFloatSignum+    (Prelude.signum (T.toFloat kprimFloatSignum z1primFloatSignum))++gprimDoubleFromInteger :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Integer Double)++gprimDoubleFromInteger pprimDoubleFromInteger p =+  T.ufun1 aprimDoubleFromInteger pprimDoubleFromInteger p hprimDoubleFromInteger++hprimDoubleFromInteger z1primDoubleFromInteger kprimDoubleFromInteger =+  T.fromDouble kprimDoubleFromInteger+    (Prelude.fromInteger+      (T.toInteger kprimDoubleFromInteger z1primDoubleFromInteger))++gprimDoubleRadix :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double Integer)++gprimDoubleRadix pprimDoubleRadix p =+  T.ufun1 aprimDoubleRadix pprimDoubleRadix p hprimDoubleRadix++hprimDoubleRadix z1primDoubleRadix kprimDoubleRadix =+  T.fromInteger kprimDoubleRadix+    (Prelude.floatRadix (T.toDouble kprimDoubleRadix z1primDoubleRadix))++gprimDoubleDigits :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double Int)++gprimDoubleDigits pprimDoubleDigits p =+  T.ufun1 aprimDoubleDigits pprimDoubleDigits p hprimDoubleDigits++hprimDoubleDigits z1primDoubleDigits kprimDoubleDigits =+  T.fromInt kprimDoubleDigits+    (Prelude.floatDigits (T.toDouble kprimDoubleDigits z1primDoubleDigits))++gprimDoubleRange ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double (T.Tuple2 Int Int))++gprimDoubleRange pprimDoubleRange p =+  T.ufun1 aprimDoubleRange pprimDoubleRange p hprimDoubleRange++hprimDoubleRange z1primDoubleRange kprimDoubleRange =+  (T.fromTuple2 T.fromInt T.fromInt) kprimDoubleRange+    (Prelude.floatRange (T.toDouble kprimDoubleRange z1primDoubleRange))++gprimDecodeDouble ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double (T.Tuple2 Integer Int))++gprimDecodeDouble pprimDecodeDouble p =+  T.ufun1 aprimDecodeDouble pprimDecodeDouble p hprimDecodeDouble++hprimDecodeDouble z1primDecodeDouble kprimDecodeDouble =+  (T.fromTuple2 T.fromInteger T.fromInt) kprimDecodeDouble+    (Prelude.decodeFloat (T.toDouble kprimDecodeDouble z1primDecodeDouble))++gprimEncodeDouble ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Integer (T.Fun Int Double))++gprimEncodeDouble pprimEncodeDouble p =+  T.ufun2 aprimEncodeDouble pprimEncodeDouble p hprimEncodeDouble++hprimEncodeDouble z1primEncodeDouble z2primEncodeDouble kprimEncodeDouble =+  T.fromDouble kprimEncodeDouble+    (Prelude.encodeFloat (T.toInteger kprimEncodeDouble z1primEncodeDouble)+      (T.toInt kprimEncodeDouble z2primEncodeDouble))++gprimDoubleIsNaN :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double Bool)++gprimDoubleIsNaN pprimDoubleIsNaN p =+  T.ufun1 aprimDoubleIsNaN pprimDoubleIsNaN p hprimDoubleIsNaN++hprimDoubleIsNaN z1primDoubleIsNaN kprimDoubleIsNaN =+  fromBool kprimDoubleIsNaN+    (Prelude.isNaN (T.toDouble kprimDoubleIsNaN z1primDoubleIsNaN))++gprimDoubleIsInfinite :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double Bool)++gprimDoubleIsInfinite pprimDoubleIsInfinite p =+  T.ufun1 aprimDoubleIsInfinite pprimDoubleIsInfinite p hprimDoubleIsInfinite++hprimDoubleIsInfinite z1primDoubleIsInfinite kprimDoubleIsInfinite =+  fromBool kprimDoubleIsInfinite+    (Prelude.isInfinite+      (T.toDouble kprimDoubleIsInfinite z1primDoubleIsInfinite))++gprimDoubleIsDenormalized :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double Bool)++gprimDoubleIsDenormalized pprimDoubleIsDenormalized p =+  T.ufun1 aprimDoubleIsDenormalized pprimDoubleIsDenormalized p+    hprimDoubleIsDenormalized++hprimDoubleIsDenormalized z1primDoubleIsDenormalized kprimDoubleIsDenormalized =+  fromBool kprimDoubleIsDenormalized+    (Prelude.isDenormalized+      (T.toDouble kprimDoubleIsDenormalized z1primDoubleIsDenormalized))++gprimDoubleIsNegativeZero :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double Bool)++gprimDoubleIsNegativeZero pprimDoubleIsNegativeZero p =+  T.ufun1 aprimDoubleIsNegativeZero pprimDoubleIsNegativeZero p+    hprimDoubleIsNegativeZero++hprimDoubleIsNegativeZero z1primDoubleIsNegativeZero kprimDoubleIsNegativeZero =+  fromBool kprimDoubleIsNegativeZero+    (Prelude.isNegativeZero+      (T.toDouble kprimDoubleIsNegativeZero z1primDoubleIsNegativeZero))++gprimDoubleIsIEEE :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double Bool)++gprimDoubleIsIEEE pprimDoubleIsIEEE p =+  T.ufun1 aprimDoubleIsIEEE pprimDoubleIsIEEE p hprimDoubleIsIEEE++hprimDoubleIsIEEE z1primDoubleIsIEEE kprimDoubleIsIEEE =+  fromBool kprimDoubleIsIEEE+    (Prelude.isIEEE (T.toDouble kprimDoubleIsIEEE z1primDoubleIsIEEE))++gprimDoubleEq ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double (T.Fun Double Bool))++gprimDoubleEq pprimDoubleEq p =+  T.ufun2 aprimDoubleEq pprimDoubleEq p hprimDoubleEq++hprimDoubleEq z1primDoubleEq z2primDoubleEq kprimDoubleEq =+  fromBool kprimDoubleEq+    ((T.toDouble kprimDoubleEq z1primDoubleEq)+      Prelude.==+      (T.toDouble kprimDoubleEq z2primDoubleEq))++gprimDoubleNe ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double (T.Fun Double Bool))++gprimDoubleNe pprimDoubleNe p =+  T.ufun2 aprimDoubleNe pprimDoubleNe p hprimDoubleNe++hprimDoubleNe z1primDoubleNe z2primDoubleNe kprimDoubleNe =+  fromBool kprimDoubleNe+    ((T.toDouble kprimDoubleNe z1primDoubleNe)+      Prelude./=+      (T.toDouble kprimDoubleNe z2primDoubleNe))++gprimDoubleLt ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double (T.Fun Double Bool))++gprimDoubleLt pprimDoubleLt p =+  T.ufun2 aprimDoubleLt pprimDoubleLt p hprimDoubleLt++hprimDoubleLt z1primDoubleLt z2primDoubleLt kprimDoubleLt =+  fromBool kprimDoubleLt+    ((T.toDouble kprimDoubleLt z1primDoubleLt)+      Prelude.<+      (T.toDouble kprimDoubleLt z2primDoubleLt))++gprimDoubleLe ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double (T.Fun Double Bool))++gprimDoubleLe pprimDoubleLe p =+  T.ufun2 aprimDoubleLe pprimDoubleLe p hprimDoubleLe++hprimDoubleLe z1primDoubleLe z2primDoubleLe kprimDoubleLe =+  fromBool kprimDoubleLe+    ((T.toDouble kprimDoubleLe z1primDoubleLe)+      Prelude.<=+      (T.toDouble kprimDoubleLe z2primDoubleLe))++gprimDoubleGt ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double (T.Fun Double Bool))++gprimDoubleGt pprimDoubleGt p =+  T.ufun2 aprimDoubleGt pprimDoubleGt p hprimDoubleGt++hprimDoubleGt z1primDoubleGt z2primDoubleGt kprimDoubleGt =+  fromBool kprimDoubleGt+    ((T.toDouble kprimDoubleGt z1primDoubleGt)+      Prelude.>+      (T.toDouble kprimDoubleGt z2primDoubleGt))++gprimDoubleGe ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double (T.Fun Double Bool))++gprimDoubleGe pprimDoubleGe p =+  T.ufun2 aprimDoubleGe pprimDoubleGe p hprimDoubleGe++hprimDoubleGe z1primDoubleGe z2primDoubleGe kprimDoubleGe =+  fromBool kprimDoubleGe+    ((T.toDouble kprimDoubleGe z1primDoubleGe)+      Prelude.>=+      (T.toDouble kprimDoubleGe z2primDoubleGe))++gprimDoublePi :: T.RefSrcPos -> T.RefExp -> T.R Double++gprimDoublePi pprimDoublePi p = T.uconstUse pprimDoublePi p sprimDoublePi++sprimDoublePi =+  T.uconstDef T.mkRoot aprimDoublePi (\ p -> T.fromDouble p Prelude.pi)++gprimDoubleExp :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double Double)++gprimDoubleExp pprimDoubleExp p =+  T.ufun1 aprimDoubleExp pprimDoubleExp p hprimDoubleExp++hprimDoubleExp z1primDoubleExp kprimDoubleExp =+  T.fromDouble kprimDoubleExp+    (Prelude.exp (T.toDouble kprimDoubleExp z1primDoubleExp))++gprimDoubleLog :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double Double)++gprimDoubleLog pprimDoubleLog p =+  T.ufun1 aprimDoubleLog pprimDoubleLog p hprimDoubleLog++hprimDoubleLog z1primDoubleLog kprimDoubleLog =+  T.fromDouble kprimDoubleLog+    (Prelude.log (T.toDouble kprimDoubleLog z1primDoubleLog))++gprimDoubleSqrt :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double Double)++gprimDoubleSqrt pprimDoubleSqrt p =+  T.ufun1 aprimDoubleSqrt pprimDoubleSqrt p hprimDoubleSqrt++hprimDoubleSqrt z1primDoubleSqrt kprimDoubleSqrt =+  T.fromDouble kprimDoubleSqrt+    (Prelude.sqrt (T.toDouble kprimDoubleSqrt z1primDoubleSqrt))++gprimDoubleSin :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double Double)++gprimDoubleSin pprimDoubleSin p =+  T.ufun1 aprimDoubleSin pprimDoubleSin p hprimDoubleSin++hprimDoubleSin z1primDoubleSin kprimDoubleSin =+  T.fromDouble kprimDoubleSin+    (Prelude.sin (T.toDouble kprimDoubleSin z1primDoubleSin))++gprimDoubleCos :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double Double)++gprimDoubleCos pprimDoubleCos p =+  T.ufun1 aprimDoubleCos pprimDoubleCos p hprimDoubleCos++hprimDoubleCos z1primDoubleCos kprimDoubleCos =+  T.fromDouble kprimDoubleCos+    (Prelude.cos (T.toDouble kprimDoubleCos z1primDoubleCos))++gprimDoubleTan :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double Double)++gprimDoubleTan pprimDoubleTan p =+  T.ufun1 aprimDoubleTan pprimDoubleTan p hprimDoubleTan++hprimDoubleTan z1primDoubleTan kprimDoubleTan =+  T.fromDouble kprimDoubleTan+    (Prelude.tan (T.toDouble kprimDoubleTan z1primDoubleTan))++gprimDoubleAsin :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double Double)++gprimDoubleAsin pprimDoubleAsin p =+  T.ufun1 aprimDoubleAsin pprimDoubleAsin p hprimDoubleAsin++hprimDoubleAsin z1primDoubleAsin kprimDoubleAsin =+  T.fromDouble kprimDoubleAsin+    (Prelude.asin (T.toDouble kprimDoubleAsin z1primDoubleAsin))++gprimDoubleAcos :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double Double)++gprimDoubleAcos pprimDoubleAcos p =+  T.ufun1 aprimDoubleAcos pprimDoubleAcos p hprimDoubleAcos++hprimDoubleAcos z1primDoubleAcos kprimDoubleAcos =+  T.fromDouble kprimDoubleAcos+    (Prelude.acos (T.toDouble kprimDoubleAcos z1primDoubleAcos))++gprimDoubleAtan :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double Double)++gprimDoubleAtan pprimDoubleAtan p =+  T.ufun1 aprimDoubleAtan pprimDoubleAtan p hprimDoubleAtan++hprimDoubleAtan z1primDoubleAtan kprimDoubleAtan =+  T.fromDouble kprimDoubleAtan+    (Prelude.atan (T.toDouble kprimDoubleAtan z1primDoubleAtan))++gprimDoubleDiv ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double (T.Fun Double Double))++gprimDoubleDiv pprimDoubleDiv p =+  T.ufun2 aprimDoubleDiv pprimDoubleDiv p hprimDoubleDiv++hprimDoubleDiv z1primDoubleDiv z2primDoubleDiv kprimDoubleDiv =+  T.fromDouble kprimDoubleDiv+    ((T.toDouble kprimDoubleDiv z1primDoubleDiv)+      Prelude./+      (T.toDouble kprimDoubleDiv z2primDoubleDiv))++gprimDoubleAdd ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double (T.Fun Double Double))++gprimDoubleAdd pprimDoubleAdd p =+  T.ufun2 aprimDoubleAdd pprimDoubleAdd p hprimDoubleAdd++hprimDoubleAdd z1primDoubleAdd z2primDoubleAdd kprimDoubleAdd =+  T.fromDouble kprimDoubleAdd+    ((T.toDouble kprimDoubleAdd z1primDoubleAdd)+      Prelude.++      (T.toDouble kprimDoubleAdd z2primDoubleAdd))++gprimDoubleSub ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double (T.Fun Double Double))++gprimDoubleSub pprimDoubleSub p =+  T.ufun2 aprimDoubleSub pprimDoubleSub p hprimDoubleSub++hprimDoubleSub z1primDoubleSub z2primDoubleSub kprimDoubleSub =+  T.fromDouble kprimDoubleSub+    ((T.toDouble kprimDoubleSub z1primDoubleSub)+      Prelude.-+      (T.toDouble kprimDoubleSub z2primDoubleSub))++gprimDoubleMul ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double (T.Fun Double Double))++gprimDoubleMul pprimDoubleMul p =+  T.ufun2 aprimDoubleMul pprimDoubleMul p hprimDoubleMul++hprimDoubleMul z1primDoubleMul z2primDoubleMul kprimDoubleMul =+  T.fromDouble kprimDoubleMul+    ((T.toDouble kprimDoubleMul z1primDoubleMul)+      Prelude.*+      (T.toDouble kprimDoubleMul z2primDoubleMul))++gprimDoubleAbs :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double Double)++gprimDoubleAbs pprimDoubleAbs p =+  T.ufun1 aprimDoubleAbs pprimDoubleAbs p hprimDoubleAbs++hprimDoubleAbs z1primDoubleAbs kprimDoubleAbs =+  T.fromDouble kprimDoubleAbs+    (Prelude.abs (T.toDouble kprimDoubleAbs z1primDoubleAbs))++gprimDoubleSignum :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Double Double)++gprimDoubleSignum pprimDoubleSignum p =+  T.ufun1 aprimDoubleSignum pprimDoubleSignum p hprimDoubleSignum++hprimDoubleSignum z1primDoubleSignum kprimDoubleSignum =+  T.fromDouble kprimDoubleSignum+    (Prelude.signum (T.toDouble kprimDoubleSignum z1primDoubleSignum))++gprimIOBind ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun (IO a) (T.Fun (T.Fun a (IO b)) (IO b)))++gprimIOBind pprimIOBind p = T.ufun2 aprimIOBind pprimIOBind p hprimIOBind++hprimIOBind z1primIOBind z2primIOBind kprimIOBind =+  (T.fromIO T.fromId) kprimIOBind+    (((T.toIO T.toId) kprimIOBind z1primIOBind)+      Prelude.>>=+      ((toFun T.fromId (T.toIO T.toId)) kprimIOBind z2primIOBind))++gprimIOReturn :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun a (IO a))++gprimIOReturn pprimIOReturn p =+  T.ufun1 aprimIOReturn pprimIOReturn p hprimIOReturn++hprimIOReturn z1primIOReturn kprimIOReturn =+  (T.fromIO T.fromId) kprimIOReturn+    (Prelude.return (T.toId kprimIOReturn z1primIOReturn))++gprimIOErrorShow :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun IOError String)++gprimIOErrorShow pprimIOErrorShow p =+  T.ufun1 aprimIOErrorShow pprimIOErrorShow p hprimIOErrorShow++hprimIOErrorShow z1primIOErrorShow kprimIOErrorShow =+  fromString kprimIOErrorShow+    (Prelude.show (toIOError kprimIOErrorShow z1primIOErrorShow))++gioError :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun IOError (IO a))++gioError pioError p = T.ufun1 aioError pioError p hioError++hioError z1ioError kioError =+  (T.fromIO T.fromId) kioError (Prelude.ioError (toIOError kioError z1ioError))++guserError :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun String IOError)++guserError puserError p = T.ufun1 auserError puserError p huserError++huserError z1userError kuserError =+  fromIOError kuserError (Prelude.userError (toString kuserError z1userError))++gcatch ::+  T.RefSrcPos ->+    T.RefExp -> T.R (T.Fun (IO a) (T.Fun (T.Fun IOError (IO a)) (IO a)))++gcatch pcatch p = T.ufun2 acatch pcatch p hcatch++hcatch z1catch z2catch kcatch =+  (T.fromIO T.fromId) kcatch+    (Prelude.catch ((T.toIO T.toId) kcatch z1catch)+      ((toFun fromIOError (T.toIO T.toId)) kcatch z2catch))++gputChar :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Char (IO T.Tuple0))++gputChar pputChar p = T.ufun1 aputChar pputChar p hputChar++hputChar z1putChar kputChar =+  (T.fromIO T.fromTuple0) kputChar+    ((\_ c -> T.outputTrace kputChar [c] Prelude.>> Prelude.putChar c) Prelude.True+      (T.toChar kputChar z1putChar))++ggetChar :: T.RefSrcPos -> T.RefExp -> T.R (IO Char)++ggetChar pgetChar p = T.uconstUse pgetChar p sgetChar++sgetChar =+  T.uconstDef T.mkRoot agetChar (\ p -> (T.fromIO T.fromChar) p Prelude.getChar)++ggetContents :: T.RefSrcPos -> T.RefExp -> T.R (IO String)++ggetContents pgetContents p = T.uconstUse pgetContents p sgetContents++sgetContents =+  T.uconstDef T.mkRoot agetContents+    (\ p -> (T.fromIO fromString) p Prelude.getContents)++greadFile :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun String (IO String))++greadFile preadFile p = T.ufun1 areadFile preadFile p hreadFile++hreadFile z1readFile kreadFile =+  (T.fromIO fromString) kreadFile+    (Prelude.readFile (toString kreadFile z1readFile))++gwriteFile ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun String (T.Fun String (IO T.Tuple0)))++gwriteFile pwriteFile p = T.ufun2 awriteFile pwriteFile p hwriteFile++hwriteFile z1writeFile z2writeFile kwriteFile =+  (T.fromIO T.fromTuple0) kwriteFile+    ((\_ n s -> T.outputTrace kwriteFile s Prelude.>> Prelude.writeFile n s) Prelude.True+      (toString kwriteFile z1writeFile) (toString kwriteFile z2writeFile))++gappendFile ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun String (T.Fun String (IO T.Tuple0)))++gappendFile pappendFile p = T.ufun2 aappendFile pappendFile p happendFile++happendFile z1appendFile z2appendFile kappendFile =+  (T.fromIO T.fromTuple0) kappendFile+    ((\_ n s -> T.outputTrace kappendFile s Prelude.>> Prelude.appendFile n s) Prelude.True+      (toString kappendFile z1appendFile) (toString kappendFile z2appendFile))++tPreludeBuiltin = T.mkModule "Prelude" "PreludeBuiltin.hs" Prelude.False++aseq = T.mkVariable tPreludeBuiltin 670001 680020 1 2 "seq" Prelude.False++aisAscii =+  T.mkVariable tPreludeBuiltin 700001 710025 3 1 "isAscii" Prelude.False++aisLatin1 =+  T.mkVariable tPreludeBuiltin 720001 730026 3 1 "isLatin1" Prelude.False++aisControl =+  T.mkVariable tPreludeBuiltin 740001 750027 3 1 "isControl" Prelude.False++aisPrint =+  T.mkVariable tPreludeBuiltin 760001 770025 3 1 "isPrint" Prelude.False++aisSpace =+  T.mkVariable tPreludeBuiltin 780001 790025 3 1 "isSpace" Prelude.False++aisUpper =+  T.mkVariable tPreludeBuiltin 800001 810025 3 1 "isUpper" Prelude.False++aisLower =+  T.mkVariable tPreludeBuiltin 820001 830025 3 1 "isLower" Prelude.False++aisAlpha =+  T.mkVariable tPreludeBuiltin 840001 850025 3 1 "isAlpha" Prelude.False++aisDigit =+  T.mkVariable tPreludeBuiltin 860001 870025 3 1 "isDigit" Prelude.False++aisOctDigit =+  T.mkVariable tPreludeBuiltin 880001 890028 3 1 "isOctDigit" Prelude.False++aisHexDigit =+  T.mkVariable tPreludeBuiltin 900001 910028 3 1 "isHexDigit" Prelude.False++aisAlphaNum =+  T.mkVariable tPreludeBuiltin 920001 930028 3 1 "isAlphaNum" Prelude.False++atoUpper =+  T.mkVariable tPreludeBuiltin 950001 960025 3 1 "toUpper" Prelude.False++atoLower =+  T.mkVariable tPreludeBuiltin 970001 980025 3 1 "toLower" Prelude.False++aprimCharToInt =+  T.mkVariable tPreludeBuiltin 1010001 1020030 3 1 "primCharToInt" Prelude.False++aprimIntToChar =+  T.mkVariable tPreludeBuiltin 1030001 1040031 3 1 "primIntToChar" Prelude.False++aprimUnicodeMaxBound =+  T.mkVariable tPreludeBuiltin 1060001 1070029 3 0 "primUnicodeMaxBound"+    Prelude.False++aprimIntMinBound =+  T.mkVariable tPreludeBuiltin 1130001 1140024 3 0 "primIntMinBound"+    Prelude.False++aprimIntMaxBound =+  T.mkVariable tPreludeBuiltin 1150001 1160024 3 0 "primIntMaxBound"+    Prelude.False++aprimIntEq =+  T.mkVariable tPreludeBuiltin 1180001 1190033 3 2 "primIntEq" Prelude.False++aprimIntNe =+  T.mkVariable tPreludeBuiltin 1200001 1210033 3 2 "primIntNe" Prelude.False++aprimIntLt =+  T.mkVariable tPreludeBuiltin 1220001 1230033 3 2 "primIntLt" Prelude.False++aprimIntLe =+  T.mkVariable tPreludeBuiltin 1240001 1250033 3 2 "primIntLe" Prelude.False++aprimIntGt =+  T.mkVariable tPreludeBuiltin 1260001 1270033 3 2 "primIntGt" Prelude.False++aprimIntGe =+  T.mkVariable tPreludeBuiltin 1280001 1290033 3 2 "primIntGe" Prelude.False++aprimIntQuot =+  T.mkVariable tPreludeBuiltin 1300001 1310036 3 2 "primIntQuot" Prelude.False++aprimIntRem =+  T.mkVariable tPreludeBuiltin 1320001 1330036 3 2 "primIntRem" Prelude.False++aprimIntPlus =+  T.mkVariable tPreludeBuiltin 1340001 1350036 3 2 "primIntPlus" Prelude.False++aprimIntMinus =+  T.mkVariable tPreludeBuiltin 1360001 1370036 3 2 "primIntMinus" Prelude.False++aprimIntTimes =+  T.mkVariable tPreludeBuiltin 1380001 1390036 3 2 "primIntTimes" Prelude.False++aprimIntNegate =+  T.mkVariable tPreludeBuiltin 1400001 1410029 3 1 "primIntNegate" Prelude.False++aprimIntAbs =+  T.mkVariable tPreludeBuiltin 1420001 1430029 3 1 "primIntAbs" Prelude.False++aprimIntSignum =+  T.mkVariable tPreludeBuiltin 1440001 1450029 3 1 "primIntSignum" Prelude.False++aprimIntegerFromInt =+  T.mkVariable tPreludeBuiltin 1470001 1480038 3 1 "primIntegerFromInt"+    Prelude.False++aprimIntFromInteger =+  T.mkVariable tPreludeBuiltin 1490001 1500038 3 1 "primIntFromInteger"+    Prelude.False++aprimIntegerEq =+  T.mkVariable tPreludeBuiltin 1520001 1530045 3 2 "primIntegerEq" Prelude.False++aprimIntegerNe =+  T.mkVariable tPreludeBuiltin 1540001 1550045 3 2 "primIntegerNe" Prelude.False++aprimIntegerLt =+  T.mkVariable tPreludeBuiltin 1560001 1570045 3 2 "primIntegerLt" Prelude.False++aprimIntegerLe =+  T.mkVariable tPreludeBuiltin 1580001 1590045 3 2 "primIntegerLe" Prelude.False++aprimIntegerGt =+  T.mkVariable tPreludeBuiltin 1600001 1610045 3 2 "primIntegerGt" Prelude.False++aprimIntegerGe =+  T.mkVariable tPreludeBuiltin 1620001 1630045 3 2 "primIntegerGe" Prelude.False++aprimIntegerQuot =+  T.mkVariable tPreludeBuiltin 1640001 1650053 3 2 "primIntegerQuot"+    Prelude.False++aprimIntegerRem =+  T.mkVariable tPreludeBuiltin 1660001 1670053 3 2 "primIntegerRem"+    Prelude.False++aprimIntegerQuotRem =+  T.mkVariable tPreludeBuiltin 1680001 1690062 3 2 "primIntegerQuotRem"+    Prelude.False++aprimIntegerAdd =+  T.mkVariable tPreludeBuiltin 1700001 1710053 3 2 "primIntegerAdd"+    Prelude.False++aprimIntegerSub =+  T.mkVariable tPreludeBuiltin 1720001 1730053 3 2 "primIntegerSub"+    Prelude.False++aprimIntegerMul =+  T.mkVariable tPreludeBuiltin 1740001 1750053 3 2 "primIntegerMul"+    Prelude.False++aprimIntegerNeg =+  T.mkVariable tPreludeBuiltin 1760001 1770042 3 1 "primIntegerNeg"+    Prelude.False++aprimFloatFromInteger =+  T.mkVariable tPreludeBuiltin 1790001 1800043 3 1 "primFloatFromInteger"+    Prelude.False++aprimFloatRadix =+  T.mkVariable tPreludeBuiltin 1810001 1820043 3 1 "primFloatRadix"+    Prelude.False++aprimFloatDigits =+  T.mkVariable tPreludeBuiltin 1830001 1840039 3 1 "primFloatDigits"+    Prelude.False++aprimFloatRange =+  T.mkVariable tPreludeBuiltin 1850001 1860044 3 1 "primFloatRange"+    Prelude.False++aprimDecodeFloat =+  T.mkVariable tPreludeBuiltin 1870001 1880048 3 1 "primDecodeFloat"+    Prelude.False++aprimEncodeFloat =+  T.mkVariable tPreludeBuiltin 1890001 1900050 3 2 "primEncodeFloat"+    Prelude.False++aprimFloatIsNaN =+  T.mkVariable tPreludeBuiltin 1910001 1920035 3 1 "primFloatIsNaN"+    Prelude.False++aprimFloatIsInfinite =+  T.mkVariable tPreludeBuiltin 1930001 1940040 3 1 "primFloatIsInfinite"+    Prelude.False++aprimFloatIsDenormalized =+  T.mkVariable tPreludeBuiltin 1950001 1960044 3 1 "primFloatIsDenormalized"+    Prelude.False++aprimFloatIsNegativeZero =+  T.mkVariable tPreludeBuiltin 1970001 1980044 3 1 "primFloatIsNegativeZero"+    Prelude.False++aprimFloatIsIEEE =+  T.mkVariable tPreludeBuiltin 1990001 2000036 3 1 "primFloatIsIEEE"+    Prelude.False++aprimFloatEq =+  T.mkVariable tPreludeBuiltin 2020001 2030039 3 2 "primFloatEq" Prelude.False++aprimFloatNe =+  T.mkVariable tPreludeBuiltin 2040001 2050039 3 2 "primFloatNe" Prelude.False++aprimFloatLt =+  T.mkVariable tPreludeBuiltin 2060001 2070039 3 2 "primFloatLt" Prelude.False++aprimFloatLe =+  T.mkVariable tPreludeBuiltin 2080001 2090039 3 2 "primFloatLe" Prelude.False++aprimFloatGt =+  T.mkVariable tPreludeBuiltin 2100001 2110039 3 2 "primFloatGt" Prelude.False++aprimFloatGe =+  T.mkVariable tPreludeBuiltin 2120001 2130039 3 2 "primFloatGe" Prelude.False++aprimFloatPi =+  T.mkVariable tPreludeBuiltin 2140001 2150022 3 0 "primFloatPi" Prelude.False++aprimFloatExp =+  T.mkVariable tPreludeBuiltin 2160001 2170033 3 1 "primFloatExp" Prelude.False++aprimFloatLog =+  T.mkVariable tPreludeBuiltin 2180001 2190033 3 1 "primFloatLog" Prelude.False++aprimFloatSqrt =+  T.mkVariable tPreludeBuiltin 2200001 2210033 3 1 "primFloatSqrt" Prelude.False++aprimFloatSin =+  T.mkVariable tPreludeBuiltin 2220001 2230033 3 1 "primFloatSin" Prelude.False++aprimFloatCos =+  T.mkVariable tPreludeBuiltin 2240001 2250033 3 1 "primFloatCos" Prelude.False++aprimFloatTan =+  T.mkVariable tPreludeBuiltin 2260001 2270033 3 1 "primFloatTan" Prelude.False++aprimFloatAsin =+  T.mkVariable tPreludeBuiltin 2280001 2290033 3 1 "primFloatAsin" Prelude.False++aprimFloatAcos =+  T.mkVariable tPreludeBuiltin 2300001 2310033 3 1 "primFloatAcos" Prelude.False++aprimFloatAtan =+  T.mkVariable tPreludeBuiltin 2320001 2330033 3 1 "primFloatAtan" Prelude.False++aprimFloatDiv =+  T.mkVariable tPreludeBuiltin 2340001 2350042 3 2 "primFloatDiv" Prelude.False++aprimFloatAdd =+  T.mkVariable tPreludeBuiltin 2360001 2370042 3 2 "primFloatAdd" Prelude.False++aprimFloatSub =+  T.mkVariable tPreludeBuiltin 2380001 2390042 3 2 "primFloatSub" Prelude.False++aprimFloatMul =+  T.mkVariable tPreludeBuiltin 2400001 2410042 3 2 "primFloatMul" Prelude.False++aprimFloatAbs =+  T.mkVariable tPreludeBuiltin 2420001 2430035 3 1 "primFloatAbs" Prelude.False++aprimFloatSignum =+  T.mkVariable tPreludeBuiltin 2440001 2450035 3 1 "primFloatSignum"+    Prelude.False++aprimDoubleFromInteger =+  T.mkVariable tPreludeBuiltin 2470001 2480044 3 1 "primDoubleFromInteger"+    Prelude.False++aprimDoubleRadix =+  T.mkVariable tPreludeBuiltin 2490001 2500040 3 1 "primDoubleRadix"+    Prelude.False++aprimDoubleDigits =+  T.mkVariable tPreludeBuiltin 2510001 2520036 3 1 "primDoubleDigits"+    Prelude.False++aprimDoubleRange =+  T.mkVariable tPreludeBuiltin 2530001 2540041 3 1 "primDoubleRange"+    Prelude.False++aprimDecodeDouble =+  T.mkVariable tPreludeBuiltin 2550001 2560044 3 1 "primDecodeDouble"+    Prelude.False++aprimEncodeDouble =+  T.mkVariable tPreludeBuiltin 2570001 2580046 3 2 "primEncodeDouble"+    Prelude.False++aprimDoubleIsNaN =+  T.mkVariable tPreludeBuiltin 2590001 2600037 3 1 "primDoubleIsNaN"+    Prelude.False++aprimDoubleIsInfinite =+  T.mkVariable tPreludeBuiltin 2610001 2620042 3 1 "primDoubleIsInfinite"+    Prelude.False++aprimDoubleIsDenormalized =+  T.mkVariable tPreludeBuiltin 2630001 2640046 3 1 "primDoubleIsDenormalized"+    Prelude.False++aprimDoubleIsNegativeZero =+  T.mkVariable tPreludeBuiltin 2650001 2660046 3 1 "primDoubleIsNegativeZero"+    Prelude.False++aprimDoubleIsIEEE =+  T.mkVariable tPreludeBuiltin 2670001 2680038 3 1 "primDoubleIsIEEE"+    Prelude.False++aprimDoubleEq =+  T.mkVariable tPreludeBuiltin 2700001 2710042 3 2 "primDoubleEq" Prelude.False++aprimDoubleNe =+  T.mkVariable tPreludeBuiltin 2720001 2730042 3 2 "primDoubleNe" Prelude.False++aprimDoubleLt =+  T.mkVariable tPreludeBuiltin 2740001 2750042 3 2 "primDoubleLt" Prelude.False++aprimDoubleLe =+  T.mkVariable tPreludeBuiltin 2760001 2770042 3 2 "primDoubleLe" Prelude.False++aprimDoubleGt =+  T.mkVariable tPreludeBuiltin 2780001 2790042 3 2 "primDoubleGt" Prelude.False++aprimDoubleGe =+  T.mkVariable tPreludeBuiltin 2800001 2810042 3 2 "primDoubleGe" Prelude.False++aprimDoublePi =+  T.mkVariable tPreludeBuiltin 2820001 2830024 3 0 "primDoublePi" Prelude.False++aprimDoubleExp =+  T.mkVariable tPreludeBuiltin 2840001 2850036 3 1 "primDoubleExp" Prelude.False++aprimDoubleLog =+  T.mkVariable tPreludeBuiltin 2860001 2870036 3 1 "primDoubleLog" Prelude.False++aprimDoubleSqrt =+  T.mkVariable tPreludeBuiltin 2880001 2890036 3 1 "primDoubleSqrt"+    Prelude.False++aprimDoubleSin =+  T.mkVariable tPreludeBuiltin 2900001 2910036 3 1 "primDoubleSin" Prelude.False++aprimDoubleCos =+  T.mkVariable tPreludeBuiltin 2920001 2930036 3 1 "primDoubleCos" Prelude.False++aprimDoubleTan =+  T.mkVariable tPreludeBuiltin 2940001 2950036 3 1 "primDoubleTan" Prelude.False++aprimDoubleAsin =+  T.mkVariable tPreludeBuiltin 2960001 2970036 3 1 "primDoubleAsin"+    Prelude.False++aprimDoubleAcos =+  T.mkVariable tPreludeBuiltin 2980001 2990036 3 1 "primDoubleAcos"+    Prelude.False++aprimDoubleAtan =+  T.mkVariable tPreludeBuiltin 3000001 3010036 3 1 "primDoubleAtan"+    Prelude.False++aprimDoubleDiv =+  T.mkVariable tPreludeBuiltin 3020001 3030046 3 2 "primDoubleDiv" Prelude.False++aprimDoubleAdd =+  T.mkVariable tPreludeBuiltin 3040001 3050046 3 2 "primDoubleAdd" Prelude.False++aprimDoubleSub =+  T.mkVariable tPreludeBuiltin 3060001 3070046 3 2 "primDoubleSub" Prelude.False++aprimDoubleMul =+  T.mkVariable tPreludeBuiltin 3080001 3090046 3 2 "primDoubleMul" Prelude.False++aprimDoubleAbs =+  T.mkVariable tPreludeBuiltin 3100001 3110038 3 1 "primDoubleAbs" Prelude.False++aprimDoubleSignum =+  T.mkVariable tPreludeBuiltin 3120001 3130038 3 1 "primDoubleSignum"+    Prelude.False++aprimIOBind =+  T.mkVariable tPreludeBuiltin 3180001 3190041 3 2 "primIOBind" Prelude.False++aprimIOReturn =+  T.mkVariable tPreludeBuiltin 3200001 3210025 3 1 "primIOReturn" Prelude.False++aprimIOErrorShow =+  T.mkVariable tPreludeBuiltin 3240001 3250038 3 1 "primIOErrorShow"+    Prelude.False++aioError =+  T.mkVariable tPreludeBuiltin 3330001 3340027 3 1 "ioError" Prelude.False++auserError =+  T.mkVariable tPreludeBuiltin 3360001 3370033 3 1 "userError" Prelude.False++acatch = T.mkVariable tPreludeBuiltin 3390001 3400043 3 2 "catch" Prelude.False++aputChar =+  T.mkVariable tPreludeBuiltin 3450001 3470023 3 1 "putChar" Prelude.False++agetChar =+  T.mkVariable tPreludeBuiltin 3490001 3500024 3 0 "getChar" Prelude.False++agetContents =+  T.mkVariable tPreludeBuiltin 3520001 3530024 3 0 "getContents" Prelude.False++areadFile =+  T.mkVariable tPreludeBuiltin 3550001 3560034 3 1 "readFile" Prelude.False++awriteFile =+  T.mkVariable tPreludeBuiltin 3580001 3590044 3 2 "writeFile" Prelude.False++aappendFile =+  T.mkVariable tPreludeBuiltin 3610001 3620044 3 2 "appendFile" Prelude.False
+ Hat/PreludeBuiltinTypes.hs view
@@ -0,0 +1,113 @@+-- Tracing version of types that are not definable in Haskell+-- or are used by functions that are not definable in Haskell+module Hat.PreludeBuiltinTypes+  (Fun(Fun) -- reexported from Hat+  ,Bool(True,False),IOError +  ,aTrue,aFalse+  ,String  -- here for convenience+  ,module Hat.PreludeBuiltinTypes+  ,gerror,gundefined+  ) where++import Hat.Hat as T+import Prelude hiding (IO,String)+import qualified Prelude++-- beside the types that cannot be defined within Haskell+-- also have to define here the types that are used by primitive functions:+-- Bool(,List),String,Tuple0,Tuple2+++-- ----------------------------------------------------------------------------+-- types:++-- Bool constructors+aTrue = T.mkConstructor tPrelude 0 0 3 0 "True"+aFalse = T.mkConstructor tPrelude 0 0 3 0 "False"++type String = List Char+++-- ----------------------------------------------------------------------------+-- type conversion functions:++-- function type is contravariant+toFun :: (RefExp -> c -> R a) -> (RefExp -> R b -> d) -> RefExp +      -> R (Fun a b) -> (c -> d)+toFun f g h (R (Fun x) _) = g h . x h . f h ++-- function type is contravariant+fromFun :: (RefExp -> R a -> b) -> (RefExp -> c -> R d) -> RefExp+        -> (b -> c) -> R (Fun a d)+fromFun f g h x = R (Fun (const (g h . x . f h))) h ++toBool :: RefExp -> R Bool -> Bool+toBool h (R b _) = b++fromBool :: RefExp -> Bool -> R Bool+fromBool t b = con0 mkNoSrcPos t b (if b then aTrue else aFalse)+++toList :: (RefExp -> R a -> b) -> RefExp -> R (List a) -> [b]+toList f h (R (Cons x xs) _) = f h x : toList f h xs+toList f h (R List _) = []++fromList :: (RefExp -> a -> R b) -> RefExp -> [a] -> R (List b)+fromList f h = fromList'+  where+  fromList' [] = con0 mkNoSrcPos h List aList+  fromList' (x:xs) = +    con2 mkNoSrcPos h Cons aCons (T.wrapForward h (f h x)) +      (T.wrapForward h (fromList' xs))++toString :: RefExp -> R String -> Prelude.String+toString = toList toChar++fromString :: RefExp -> Prelude.String -> R String+fromString = fromList fromChar++-- toPolyList :: R (List a) -> [R a]+-- toPolyList = toList id++-- fromPolyList :: RefExp -> [R a] -> R (List a)+-- fromPolyList = fromList (\_ x -> x)++toIOError :: RefExp -> R IOError -> Prelude.IOError+toIOError h (R e _) = e++fromIOError :: RefExp -> Prelude.IOError -> R IOError+fromIOError h e = R e (T.mkValueUse h mkNoSrcPos aIOError)++aIOError :: RefAtom+aIOError = T.mkAbstract "IOError"+++-- primitive functions where the trace is handled specially++-- error calls exits with primitive function hatError++gerror perror jerror = T.fun1 aerror perror jerror herror ++herror :: R String -> RefExp -> a+herror z1error kerror = T.hatError kerror (toString kerror z1error)++aerror = T.mkVariable tPrelude 0 0 3 1 "error" Prelude.False++-- hack so that context of undefined is its proper parent +gundefined :: T.RefSrcPos -> T.RefExp -> T.R a+gundefined pundefined p = cUse+  where+  cUse@(T.R _ cRef) = T.uconstUse pundefined p sundefined+  sundefined = T.uconstDef p aundefined (const (hundefined cRef))++-- gundefined pundefined jundefined = T.constDef jundefined aundefined hundefined++hundefined :: RefExp -> a+hundefined kundefined = T.hatError kundefined "Prelude.undefined"++aundefined = T.mkVariable tPrelude 0 0 3 0 "undefined" Prelude.False+++++
+ Hat/Random.hs view
@@ -0,0 +1,855 @@+module Hat.Random+  (RandomGen(gnext,gsplit,ggenRange,snext,ssplit,sgenRange),StdGen(),gmkStdGen+    ,amkStdGen,hmkStdGen,Random(grandom,grandomR,grandoms,grandomRs,grandomIO+      ,grandomRIO,srandom,srandomR,srandoms,srandomRs,srandomIO,srandomRIO)+    ,ggetStdRandom,agetStdRandom,hgetStdRandom,ggetStdGen,gsetStdGen,asetStdGen+    ,hsetStdGen,gnewStdGen) where++import qualified Hat.PreludeBasic +import qualified Prelude +import Hat.Hack +import qualified Hat.Hat as T +import Hat.Hat  (WrapVal(wrapVal))+import Hat.Prelude +import Hat.PreludeBuiltinTypes +import Hat.RandomBuiltin +import qualified System.Random as Random +import Hat.Char ++class RandomGen g+  where+  +  ggenRange :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun g (T.Tuple2 Int Int))+  +  gnext :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun g (T.Tuple2 Int g))+  +  gsplit :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun g (T.Tuple2 g g))+  +  ggenRange pgenRange p =+    T.ufun1 a24v3v24v34genRange pgenRange p hgenRange+    where+    +    hgenRange fg p =+      T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 (gminBound T.mkNoSrcPos p)+        (gmaxBound T.mkNoSrcPos p)+    +  +  sgenRange :: T.R (T.Fun g (T.Tuple2 Int Int))+  +  snext :: T.R (T.Fun g (T.Tuple2 Int g))+  +  ssplit :: T.R (T.Fun g (T.Tuple2 g g))+  ++instance RandomGen (StdGen)+  where+  +  ggenRange pgenRange p = T.uconstUse pgenRange p sgenRange+  +  sgenRange =+    T.uconstDef T.mkRoot a31v3v31v31genRange+      (\ p -> gprimStdGenGenRange T.mkNoSrcPos p)+  +  gnext pnext p = T.uconstUse pnext p snext+  +  snext =+    T.uconstDef T.mkRoot a32v3v32v23next (\ p -> gprimStdGenNext T.mkNoSrcPos p)+  +  gsplit psplit p = T.uconstUse psplit p ssplit+  +  ssplit =+    T.uconstDef T.mkRoot a33v3v33v25split+      (\ p -> gprimStdGenSplit T.mkNoSrcPos p)+  ++instance Read (StdGen)+  where+  +  greadsPrec preadsPrec p = T.uconstUse preadsPrec p sreadsPrec+  +  sreadsPrec =+    T.uconstDef T.mkRoot a36v3v36v33readsPrec+      (\ p -> gprimStdGenReadsPrec T.mkNoSrcPos p)+  ++instance Show (StdGen)+  where+  +  gshowsPrec pshowsPrec p = T.uconstUse pshowsPrec p sshowsPrec+  +  sshowsPrec =+    T.uconstDef T.mkRoot a39v3v39v33showsPrec+      (\ p -> gprimStdGenShowsPrec T.mkNoSrcPos p)+  ++gprimStdGenGenRange ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun StdGen (T.Tuple2 Int Int))++gprimStdGenGenRange pprimStdGenGenRange p =+  T.ufun1 aprimStdGenGenRange pprimStdGenGenRange p hprimStdGenGenRange++hprimStdGenGenRange z1primStdGenGenRange kprimStdGenGenRange =+  (T.fromTuple2 T.fromInt T.fromInt) kprimStdGenGenRange+    (Random.genRange (toStdGen kprimStdGenGenRange z1primStdGenGenRange))++gprimStdGenNext ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun StdGen (T.Tuple2 Int StdGen))++gprimStdGenNext pprimStdGenNext p =+  T.ufun1 aprimStdGenNext pprimStdGenNext p hprimStdGenNext++hprimStdGenNext z1primStdGenNext kprimStdGenNext =+  (T.fromTuple2 T.fromInt fromStdGen) kprimStdGenNext+    (Random.next (toStdGen kprimStdGenNext z1primStdGenNext))++gprimStdGenSplit ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun StdGen (T.Tuple2 StdGen StdGen))++gprimStdGenSplit pprimStdGenSplit p =+  T.ufun1 aprimStdGenSplit pprimStdGenSplit p hprimStdGenSplit++hprimStdGenSplit z1primStdGenSplit kprimStdGenSplit =+  (T.fromTuple2 fromStdGen fromStdGen) kprimStdGenSplit+    (Random.split (toStdGen kprimStdGenSplit z1primStdGenSplit))++gprimStdGenReadsPrec ::+  T.RefSrcPos ->+    T.RefExp -> T.R (T.Fun Int (T.Fun String (T.List (T.Tuple2 StdGen String))))++gprimStdGenReadsPrec pprimStdGenReadsPrec p =+  T.ufun2 aprimStdGenReadsPrec pprimStdGenReadsPrec p hprimStdGenReadsPrec++hprimStdGenReadsPrec z1primStdGenReadsPrec z2primStdGenReadsPrec+  kprimStdGenReadsPrec =+  (fromList (T.fromTuple2 fromStdGen fromString)) kprimStdGenReadsPrec+    (Prelude.readsPrec (T.toInt kprimStdGenReadsPrec z1primStdGenReadsPrec)+      (toString kprimStdGenReadsPrec z2primStdGenReadsPrec))++gprimStdGenShowsPrec ::+  T.RefSrcPos ->+    T.RefExp -> T.R (T.Fun Int (T.Fun StdGen (T.Fun String String)))++gprimStdGenShowsPrec pprimStdGenShowsPrec p =+  T.ufun3 aprimStdGenShowsPrec pprimStdGenShowsPrec p hprimStdGenShowsPrec++hprimStdGenShowsPrec z1primStdGenShowsPrec z2primStdGenShowsPrec+  z3primStdGenShowsPrec kprimStdGenShowsPrec =+  fromString kprimStdGenShowsPrec+    (Prelude.showsPrec (T.toInt kprimStdGenShowsPrec z1primStdGenShowsPrec)+      (toStdGen kprimStdGenShowsPrec z2primStdGenShowsPrec)+      (toString kprimStdGenShowsPrec z3primStdGenShowsPrec))++gmkStdGen :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Int StdGen)++gmkStdGen pmkStdGen p = T.ufun1 amkStdGen pmkStdGen p hmkStdGen++hmkStdGen z1mkStdGen kmkStdGen =+  fromStdGen kmkStdGen (Random.mkStdGen (T.toInt kmkStdGen z1mkStdGen))++class Random a+  where+  +  grandomR ::+    RandomGen g =>+    T.RefSrcPos ->+      T.RefExp -> T.R (T.Fun (T.Tuple2 a a) (T.Fun g (T.Tuple2 a g)))+  +  grandom ::+    RandomGen g => T.RefSrcPos -> T.RefExp -> T.R (T.Fun g (T.Tuple2 a g))+  +  grandomRs ::+    RandomGen g =>+    T.RefSrcPos -> T.RefExp -> T.R (T.Fun (T.Tuple2 a a) (T.Fun g (T.List a)))+  +  grandoms :: RandomGen g => T.RefSrcPos -> T.RefExp -> T.R (T.Fun g (T.List a))+  +  grandomRIO :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun (T.Tuple2 a a) (IO a))+  +  grandomIO :: T.RefSrcPos -> T.RefExp -> T.R (IO a)+  +  grandoms prandoms p =+    T.ufun1 a68v3v70v21randoms prandoms p hrandoms+    where+    +    hrandoms fg p =+      T.con2 T.mkNoSrcPos p T.Cons T.aCons (gx T.mkNoSrcPos p)+        (T.uap1 T.mkNoSrcPos p (grandoms T.mkNoSrcPos p) (gg' T.mkNoSrcPos p))+      where+      +      gx px p = T.uconstUse px p sx+      +      gg' px p = T.uconstUse px p sg'+      +      j70v5v70v10x =+        case T.uap1 T.mkNoSrcPos p (grandom T.mkNoSrcPos p) fg of+          T.R (T.Tuple2 fx fg') kx -> (kx,fx,fg')+          _ -> T.fatal p+      +      sx =+        T.uconstDef p a70v6v70v6x+          (\ _ -> case j70v5v70v10x of (kx,fx,fg') -> fx)+      +      sg' =+        T.uconstDef p a70v8v70v9g'+          (\ _ -> case j70v5v70v10x of (kx,fx,fg') -> fg')+      +    +  +  grandomRs prandomRs p =+    T.ufun2 a71v3v73v28randomRs prandomRs p hrandomRs+    where+    +    hrandomRs frange fg p =+      T.con2 T.mkNoSrcPos p T.Cons T.aCons (gx T.mkNoSrcPos p)+        (T.uap2 T.mkNoSrcPos p (grandomRs T.mkNoSrcPos p) frange+          (gg' T.mkNoSrcPos p))+      where+      +      gx px p = T.uconstUse px p sx+      +      gg' px p = T.uconstUse px p sg'+      +      j73v5v73v10x =+        case T.uap2 T.mkNoSrcPos p (grandomR T.mkNoSrcPos p) frange fg of+          T.R (T.Tuple2 fx fg') kx -> (kx,fx,fg')+          _ -> T.fatal p+      +      sx =+        T.uconstDef p a73v6v73v6x+          (\ _ -> case j73v5v73v10x of (kx,fx,fg') -> fx)+      +      sg' =+        T.uconstDef p a73v8v73v9g'+          (\ _ -> case j73v5v73v10x of (kx,fx,fg') -> fg')+      +    +  +  grandomIO prandomIO p = T.uconstUse prandomIO p srandomIO+  +  srandomIO =+    T.uconstDef T.mkRoot a74v3v74v39randomIO+      (\ p -> T.uwrapForward p (hgetStdRandom (grandom T.mkNoSrcPos p) p))+  +  grandomRIO prandomRIO p =+    T.ufun1 a75v3v75v47randomRIO prandomRIO p hrandomRIO+    where+    +    hrandomRIO frange p =+      T.uwrapForward p+        (hgetStdRandom (T.uap1 T.mkNoSrcPos p (grandomR T.mkNoSrcPos p) frange)+          p)+    +  +  srandomR :: RandomGen g => T.R (T.Fun (T.Tuple2 a a) (T.Fun g (T.Tuple2 a g)))+  +  srandom :: RandomGen g => T.R (T.Fun g (T.Tuple2 a g))+  +  srandomRs :: RandomGen g => T.R (T.Fun (T.Tuple2 a a) (T.Fun g (T.List a)))+  +  srandoms :: RandomGen g => T.R (T.Fun g (T.List a))+  +  srandomRIO :: T.R (T.Fun (T.Tuple2 a a) (IO a))+  +  srandomIO :: T.R (IO a)+  ++instance Random (Int)+  where+  +  grandomR prandomR p =+    T.ufun2 a78v3v78v66randomR prandomR p hrandomR+    where+    +    hrandomR (T.R (T.Tuple2 fa fb) _) fg p =+      T.uwrapForward p+        (hrandomIvalInteger+          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+            (T.uap1 T.mkNoSrcPos p (gtoInteger T.mkNoSrcPos p) fa)+            (T.uap1 T.mkNoSrcPos p (gtoInteger T.mkNoSrcPos p) fb)) fg p)+    hrandomR _ _ p = T.fatal p+    +  +  grandom prandom p =+    T.ufun1 a79v3v79v49random prandom p hrandom+    where+    +    hrandom fg p =+      T.uap2 T.mkNoSrcPos p (grandomR T.mkNoSrcPos p)+        (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 (gminBound T.mkNoSrcPos p)+          (gmaxBound T.mkNoSrcPos p)) fg+    +  ++instance Random (Integer)+  where+  +  grandomR prandomR p =+    T.ufun2 a82v3v82v43randomR prandomR p hrandomR+    where+    +    hrandomR fival fg p = T.uwrapForward p (hrandomIvalInteger fival fg p)+    +  +  grandom prandom p =+    T.ufun1 a83v3v83v83random prandom p hrandom+    where+    +    hrandom fg p =+      T.uap2 T.mkNoSrcPos p (grandomR T.mkNoSrcPos p)+        (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+          (T.uap1 T.mkNoSrcPos p (gtoInteger T.mkNoSrcPos p)+            (gminBound T.mkNoSrcPos p :: T.R Int))+          (T.uap1 T.mkNoSrcPos p (gtoInteger T.mkNoSrcPos p)+            (gmaxBound T.mkNoSrcPos p :: T.R Int))) fg+    +  ++instance Random (Float)+  where+  +  grandom prandom p =+    T.ufun1 a86v3v86v63random prandom p hrandom+    where+    +    hrandom fg p =+      T.uwrapForward p+        (hrandomIvalDouble+          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+            (T.uap1 T.mkNoSrcPos p+                (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                (T.conInteger T.mkNoSrcPos p 0)+              :: T.R Double)+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 1))) (grealToFrac T.mkNoSrcPos p) fg+          p)+    +  +  grandomR prandomR p =+    T.ufun2 a87v3v87v78randomR prandomR p hrandomR+    where+    +    hrandomR (T.R (T.Tuple2 fa fb) _) fg p =+      T.uwrapForward p+        (hrandomIvalDouble+          (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+            (T.uap1 T.mkNoSrcPos p (grealToFrac T.mkNoSrcPos p) fa)+            (T.uap1 T.mkNoSrcPos p (grealToFrac T.mkNoSrcPos p) fb))+          (grealToFrac T.mkNoSrcPos p) fg p)+    hrandomR _ _ p = T.fatal p+    +  ++instance Random (Double)+  where+  +  grandomR prandomR p =+    T.ufun2 a90v3v90v45randomR prandomR p hrandomR+    where+    +    hrandomR fival fg p =+      T.uwrapForward p (hrandomIvalDouble fival (gid T.mkNoSrcPos p) fg p)+    +  +  grandom prandom p =+    T.ufun1 a91v3v91v42random prandom p hrandom+    where+    +    hrandom fg p =+      T.uap2 T.mkNoSrcPos p (grandomR T.mkNoSrcPos p)+        (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 0)+            :: T.R Double)+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 1))) fg+    +  ++instance Random (Bool)+  where+  +  grandomR prandomR p =+    T.ufun2 a94v3v105v22randomR prandomR p hrandomR+    where+    +    hrandomR (T.R (T.Tuple2 fa fb) _) fg p =+      T.uccase T.mkNoSrcPos p+        (let+          v95v5v97v33v1 (T.R (T.Tuple2 fx fg) _) p =+            T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+              (T.uwrapForward p (hint2Bool fx p)) fg+          v95v5v97v33v1 _ p = T.fatal p in (v95v5v97v33v1))+        (T.uwrapForward p+          (hrandomIvalInteger+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+              (T.uwrapForward p (hbool2Integer fa p))+              (T.uwrapForward p (hbool2Integer fb p))) fg p))+      where+      +      gbool2Integer :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Bool Integer)+      +      hbool2Integer :: (T.R Bool) -> T.RefExp -> T.R Integer+      +      gbool2Integer pbool2Integer p =+        T.ufun1 a100v5v101v26bool2Integer pbool2Integer p hbool2Integer+      +      abool2Integer = a100v5v101v26bool2Integer+      +      hbool2Integer (T.R False _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0)+      hbool2Integer (T.R True _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 1)+      hbool2Integer _ p = T.fatal p+      +      gint2Bool :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Int Bool)+      +      hint2Bool :: (T.R Int) -> T.RefExp -> T.R Bool+      +      gint2Bool pint2Bool p =+        T.ufun1 a104v5v105v22int2Bool pint2Bool p hint2Bool+      +      aint2Bool = a104v5v105v22int2Bool+      +      hint2Bool fv104v14v104v14n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p)+            fv104v14v104v14n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 0))) (h p)+          (y1int2Bool fv104v14v104v14n p)+        where+        +        h p = T.con0 T.mkNoSrcPos p False aFalse+        h p = y1int2Bool fv104v14v104v14n p+        +      hint2Bool fv104v14v104v14n p = y1int2Bool fv104v14v104v14n p+      +      y1int2Bool _ p = T.con0 T.mkNoSrcPos p True aTrue+      +    hrandomR _ _ p = T.fatal p+    +  +  grandom prandom p =+    T.ufun1 a107v3v107v42random prandom p hrandom+    where+    +    hrandom fg p =+      T.uap2 T.mkNoSrcPos p (grandomR T.mkNoSrcPos p)+        (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 (gminBound T.mkNoSrcPos p)+          (gmaxBound T.mkNoSrcPos p)) fg+    +  ++instance Random (Char)+  where+  +  grandomR prandomR p =+    T.ufun2 a110v3v112v27randomR prandomR p hrandomR+    where+    +    hrandomR (T.R (T.Tuple2 fa fb) _) fg p =+      T.uccase T.mkNoSrcPos p+        (let+          v111v7v112v27v1 (T.R (T.Tuple2 fx fg) _) p =+            T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+              (T.uap1 T.mkNoSrcPos p (gchr T.mkNoSrcPos p) fx) fg+          v111v7v112v27v1 _ p = T.fatal p in (v111v7v112v27v1))+        (T.uwrapForward p+          (hrandomIvalInteger+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+              (T.uap1 T.mkNoSrcPos p (gtoInteger T.mkNoSrcPos p)+                (T.uap1 T.mkNoSrcPos p (gord T.mkNoSrcPos p) fa))+              (T.uap1 T.mkNoSrcPos p (gtoInteger T.mkNoSrcPos p)+                (T.uap1 T.mkNoSrcPos p (gord T.mkNoSrcPos p) fb))) fg p))+    hrandomR _ _ p = T.fatal p+    +  +  grandom prandom p =+    T.ufun1 a113v3v113v42random prandom p hrandom+    where+    +    hrandom fg p =+      T.uap2 T.mkNoSrcPos p (grandomR T.mkNoSrcPos p)+        (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 (gminBound T.mkNoSrcPos p)+          (gmaxBound T.mkNoSrcPos p)) fg+    +  ++grandomIvalInteger ::+  (RandomGen g,Num a) =>+  T.RefSrcPos ->+    T.RefExp -> T.R (T.Fun (T.Tuple2 Integer Integer) (T.Fun g (T.Tuple2 a g)))++hrandomIvalInteger ::+  (RandomGen g,Num a) =>+  (T.R (T.Tuple2 Integer Integer)) -> (T.R g) -> T.RefExp -> T.R (T.Tuple2 a g)++grandomIvalInteger prandomIvalInteger p =+  T.ufun2 arandomIvalInteger prandomIvalInteger p hrandomIvalInteger++hrandomIvalInteger (T.R (T.Tuple2 fl fh) _) frng p =+  T.ucguard (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !> p) fl fh)+    (T.uwrapForward p+      (hrandomIvalInteger (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fh fl) frng+        p))+    (T.ucguard (gotherwise T.mkNoSrcPos p)+      (T.uccase T.mkNoSrcPos p+        (let+          v120v16v120v83v1 (T.R (T.Tuple2 fv frng') _) p =+            T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+              (T.uap1 T.mkNoSrcPos p (gfromInteger T.mkNoSrcPos p)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p) fl+                  (T.uap2 T.mkNoSrcPos p (gmod T.mkNoSrcPos p) fv+                    (gk T.mkNoSrcPos p)))) frng'+          v120v16v120v83v1 _ p = T.fatal p in (v120v16v120v83v1))+        (T.uwrapForward p+          (hf (gn T.mkNoSrcPos p)+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 1)) frng p))) (T.fatal p))+  where+  +  gk pk p = T.uconstUse pk p sk+  +  sk =+    T.uconstDef p a122v8v122v20k+      (\ p ->+        T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !- p) fh fl)+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 1)))+  +  gb pb p = T.uconstUse pb p sb+  +  sb =+    T.uconstDef p a123v8v123v21b+      (\ p ->+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 2147483561))+  +  gn pn p = T.uconstUse pn p sn+  +  sn =+    T.uconstDef p a124v8v124v23n+      (\ p ->+        T.uwrapForward p (hiLogBase (gb T.mkNoSrcPos p) (gk T.mkNoSrcPos p) p))+  +  gf pf p = T.ufun3 a126v8v131v42f pf p hf+  +  af = a126v8v131v42f+  +  hf fv126v10v126v10n facc fg p =+    T.ucguard+      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv126v10v126v10n+        (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0))) (h facc fg p)+      (y1f fv126v10v126v10n facc fg p)+    where+    +    h facc fg p = T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 facc fg+    h _ _ p = y1f fv126v10v126v10n facc fg p+    +  hf fv126v10v126v10n facc fg p = y1f fv126v10v126v10n facc fg p+  +  y1f fn facc fg p =+    let+      gx px p = T.uconstUse px p sx+      gg' px p = T.uconstUse px p sg'+      j129v12v129v17x =+        case T.uap1 T.mkNoSrcPos p (gnext T.mkNoSrcPos p) fg of+          T.R (T.Tuple2 fx fg') kx -> (kx,fx,fg')+          _ -> T.fatal p+      sx =+        T.uconstDef p a129v13v129v13x+          (\ _ -> case j129v12v129v17x of (kx,fx,fg') -> fx)+      sg' =+        T.uconstDef p a129v15v129v16g'+          (\ _ -> case j129v12v129v17x of (kx,fx,fg') -> fg') in+      (T.uwrapForward p+        (hf+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !- p) fn+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 1)))+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+            (T.uap1 T.mkNoSrcPos p (gfromInt T.mkNoSrcPos p)+              (gx T.mkNoSrcPos p))+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p) facc+              (gb T.mkNoSrcPos p))) (gg' T.mkNoSrcPos p) p))+  +hrandomIvalInteger _ _ p = T.fatal p++grandomIvalDouble ::+  (RandomGen g,Fractional a) =>+  T.RefSrcPos ->+    T.RefExp ->+      T.R+        (T.Fun (T.Tuple2 Double Double)+          (T.Fun (T.Fun Double a) (T.Fun g (T.Tuple2 a g))))++hrandomIvalDouble ::+  (RandomGen g,Fractional a) =>+  (T.R (T.Tuple2 Double Double)) ->+    (T.R (T.Fun Double a)) -> (T.R g) -> T.RefExp -> T.R (T.Tuple2 a g)++grandomIvalDouble prandomIvalDouble p =+  T.ufun3 arandomIvalDouble prandomIvalDouble p hrandomIvalDouble++hrandomIvalDouble (T.R (T.Tuple2 fl fh) _) ffromDouble frng p =+  T.ucguard (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !> p) fl fh)+    (T.uwrapForward p+      (hrandomIvalDouble (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2 fh fl)+        ffromDouble frng p))+    (T.ucguard (gotherwise T.mkNoSrcPos p)+      (T.uccase T.mkNoSrcPos p+        (let+          v137v8v145v28v1 (T.R (T.Tuple2 fx frng') _) p =+            let+              gscaled_x pscaled_x p = T.uconstUse pscaled_x p sscaled_x+              sscaled_x =+                T.uconstDef p a140v14v143v36scaled_x+                  (\ p ->+                    T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+                      (T.uap1 T.mkNoSrcPos p ffromDouble+                        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !/ p)+                          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p) fl fh)+                          (T.uap1 T.mkNoSrcPos p+                            (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                            (T.conInteger T.mkNoSrcPos p 2))))+                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !* p)+                        (T.uap1 T.mkNoSrcPos p ffromDouble+                          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !/ p)+                            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !- p) fh fl)+                            (T.uap1 T.mkNoSrcPos p (grealToFrac T.mkNoSrcPos p)+                              (gintRange T.mkNoSrcPos p))))+                        (T.uap1 T.mkNoSrcPos p (gfromIntegral T.mkNoSrcPos p)+                          (fx :: T.R Int)))) in+              (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+                (gscaled_x T.mkNoSrcPos p) frng')+          v137v8v145v28v1 _ p = T.fatal p in (v137v8v145v28v1))+        (T.uwrapForward p+          (hrandomIvalInteger+            (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+              (T.uap1 T.mkNoSrcPos p (gtoInteger T.mkNoSrcPos p)+                (gminBound T.mkNoSrcPos p :: T.R Int))+              (T.uap1 T.mkNoSrcPos p (gtoInteger T.mkNoSrcPos p)+                (gmaxBound T.mkNoSrcPos p :: T.R Int))) frng p))) (T.fatal p))+hrandomIvalDouble _ _ _ p = T.fatal p++gfromInt :: Num a => T.RefSrcPos -> T.RefExp -> T.R (T.Fun Int a)++sfromInt :: Num a => T.R (T.Fun Int a)++gfromInt pfromInt p = T.uconstUse pfromInt p sfromInt++sfromInt =+  T.uconstDef T.mkRoot afromInt+    (\ p ->+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !. p) (gfromInteger T.mkNoSrcPos p)+        (gtoInteger T.mkNoSrcPos p))++gintRange :: T.RefSrcPos -> T.RefExp -> T.R Integer++sintRange :: T.R Integer++gintRange pintRange p = T.uconstUse pintRange p sintRange++sintRange =+  T.uconstDef T.mkRoot aintRange+    (\ p ->+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !- p)+        (T.uap1 T.mkNoSrcPos p (gtoInteger T.mkNoSrcPos p)+          (gmaxBound T.mkNoSrcPos p :: T.R Int))+        (T.uap1 T.mkNoSrcPos p (gtoInteger T.mkNoSrcPos p)+          (gminBound T.mkNoSrcPos p :: T.R Int)))++giLogBase ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun Integer (T.Fun Integer Integer))++hiLogBase :: (T.R Integer) -> (T.R Integer) -> T.RefExp -> T.R Integer++giLogBase piLogBase p = T.ufun2 aiLogBase piLogBase p hiLogBase++hiLogBase fb fi p =+  T.ucif p (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !< p) fi fb)+    (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+      (T.conInteger T.mkNoSrcPos p 1))+    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos !+ p)+      (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 1))+      (T.uwrapForward p+        (hiLogBase fb (T.uap2 T.mkNoSrcPos p (gdiv T.mkNoSrcPos p) fi fb) p)))++gnewStdGen :: T.RefSrcPos -> T.RefExp -> T.R (IO StdGen)++gnewStdGen pnewStdGen p = T.uconstUse pnewStdGen p snewStdGen++snewStdGen =+  T.uconstDef T.mkRoot anewStdGen+    (\ p -> (T.fromIO fromStdGen) p Random.newStdGen)++gsetStdGen :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun StdGen (IO T.Tuple0))++gsetStdGen psetStdGen p = T.ufun1 asetStdGen psetStdGen p hsetStdGen++hsetStdGen z1setStdGen ksetStdGen =+  (T.fromIO T.fromTuple0) ksetStdGen+    (Random.setStdGen (toStdGen ksetStdGen z1setStdGen))++ggetStdGen :: T.RefSrcPos -> T.RefExp -> T.R (IO StdGen)++ggetStdGen pgetStdGen p = T.uconstUse pgetStdGen p sgetStdGen++sgetStdGen =+  T.uconstDef T.mkRoot agetStdGen+    (\ p -> (T.fromIO fromStdGen) p Random.getStdGen)++ggetStdRandom ::+  T.RefSrcPos ->+    T.RefExp -> T.R (T.Fun (T.Fun StdGen (T.Tuple2 a StdGen)) (IO a))++ggetStdRandom pgetStdRandom p =+  T.ufun1 agetStdRandom pgetStdRandom p hgetStdRandom++hgetStdRandom z1getStdRandom kgetStdRandom =+  (T.fromIO T.fromId) kgetStdRandom+    (Random.getStdRandom+      ((toFun fromStdGen (T.toTuple2 T.toId toStdGen)) kgetStdRandom+        z1getStdRandom))++tRandom = T.mkModule "Random" "Random.hs" Prelude.False++aprimStdGenGenRange =+  T.mkVariable tRandom 410001 420041 3 1 "primStdGenGenRange" Prelude.False++aprimStdGenNext =+  T.mkVariable tRandom 430001 440040 3 1 "primStdGenNext" Prelude.False++aprimStdGenSplit =+  T.mkVariable tRandom 450001 460044 3 1 "primStdGenSplit" Prelude.False++aprimStdGenReadsPrec =+  T.mkVariable tRandom 470001 480042 3 2 "primStdGenReadsPrec" Prelude.False++aprimStdGenShowsPrec =+  T.mkVariable tRandom 490001 500057 3 3 "primStdGenShowsPrec" Prelude.False++amkStdGen = T.mkVariable tRandom 530001 540026 3 1 "mkStdGen" Prelude.False++arandomIvalInteger =+  T.mkVariable tRandom 1180001 1310042 3 2 "randomIvalInteger" Prelude.False++arandomIvalDouble =+  T.mkVariable tRandom 1340001 1450028 3 3 "randomIvalDouble" Prelude.False++afromInt = T.mkVariable tRandom 1480001 1480033 3 0 "fromInt" Prelude.False++aintRange = T.mkVariable tRandom 1510001 1510064 3 0 "intRange" Prelude.False++aiLogBase = T.mkVariable tRandom 1540001 1540061 3 2 "iLogBase" Prelude.False++anewStdGen = T.mkVariable tRandom 1580001 1590019 3 0 "newStdGen" Prelude.False++asetStdGen = T.mkVariable tRandom 1600001 1610029 3 1 "setStdGen" Prelude.False++agetStdGen = T.mkVariable tRandom 1620001 1630019 3 0 "getStdGen" Prelude.False++agetStdRandom =+  T.mkVariable tRandom 1640001 1650046 3 1 "getStdRandom" Prelude.False++a24v3v24v34genRange =+  T.mkVariable tRandom 240003 240034 3 1 "genRange" Prelude.False++a31v3v31v31genRange =+  T.mkVariable tRandom 310003 310031 3 0 "genRange" Prelude.False++a32v3v32v23next = T.mkVariable tRandom 320003 320023 3 0 "next" Prelude.False++a33v3v33v25split = T.mkVariable tRandom 330003 330025 3 0 "split" Prelude.False++a36v3v36v33readsPrec =+  T.mkVariable tRandom 360003 360033 3 0 "readsPrec" Prelude.False++a39v3v39v33showsPrec =+  T.mkVariable tRandom 390003 390033 3 0 "showsPrec" Prelude.False++a68v3v70v21randoms =+  T.mkVariable tRandom 680003 700021 3 1 "randoms" Prelude.False++a71v3v73v28randomRs =+  T.mkVariable tRandom 710003 730028 3 2 "randomRs" Prelude.False++a74v3v74v39randomIO =+  T.mkVariable tRandom 740003 740039 3 0 "randomIO" Prelude.False++a75v3v75v47randomRIO =+  T.mkVariable tRandom 750003 750047 3 1 "randomRIO" Prelude.False++a78v3v78v66randomR =+  T.mkVariable tRandom 780003 780066 3 2 "randomR" Prelude.False++a79v3v79v49random =+  T.mkVariable tRandom 790003 790049 3 1 "random" Prelude.False++a82v3v82v43randomR =+  T.mkVariable tRandom 820003 820043 3 2 "randomR" Prelude.False++a83v3v83v83random =+  T.mkVariable tRandom 830003 830083 3 1 "random" Prelude.False++a86v3v86v63random =+  T.mkVariable tRandom 860003 860063 3 1 "random" Prelude.False++a87v3v87v78randomR =+  T.mkVariable tRandom 870003 870078 3 2 "randomR" Prelude.False++a90v3v90v45randomR =+  T.mkVariable tRandom 900003 900045 3 2 "randomR" Prelude.False++a91v3v91v42random =+  T.mkVariable tRandom 910003 910042 3 1 "random" Prelude.False++a94v3v105v22randomR =+  T.mkVariable tRandom 940003 1050022 3 2 "randomR" Prelude.False++a107v3v107v42random =+  T.mkVariable tRandom 1070003 1070042 3 1 "random" Prelude.False++a110v3v112v27randomR =+  T.mkVariable tRandom 1100003 1120027 3 2 "randomR" Prelude.False++a113v3v113v42random =+  T.mkVariable tRandom 1130003 1130042 3 1 "random" Prelude.False++a70v6v70v6x = T.mkVariable tRandom 700006 700006 3 0 "x" Prelude.True++a70v8v70v9g' = T.mkVariable tRandom 700008 700009 3 0 "g'" Prelude.True++a73v6v73v6x = T.mkVariable tRandom 730006 730006 3 0 "x" Prelude.True++a73v8v73v9g' = T.mkVariable tRandom 730008 730009 3 0 "g'" Prelude.True++a100v5v101v26bool2Integer =+  T.mkVariable tRandom 1000005 1010026 3 1 "bool2Integer" Prelude.True++a104v5v105v22int2Bool =+  T.mkVariable tRandom 1040005 1050022 3 1 "int2Bool" Prelude.True++a122v8v122v20k = T.mkVariable tRandom 1220008 1220020 3 0 "k" Prelude.True++a123v8v123v21b = T.mkVariable tRandom 1230008 1230021 3 0 "b" Prelude.True++a124v8v124v23n = T.mkVariable tRandom 1240008 1240023 3 0 "n" Prelude.True++a126v8v131v42f = T.mkVariable tRandom 1260008 1310042 3 3 "f" Prelude.True++a129v13v129v13x = T.mkVariable tRandom 1290013 1290013 3 0 "x" Prelude.True++a129v15v129v16g' = T.mkVariable tRandom 1290015 1290016 3 0 "g'" Prelude.True++a140v14v143v36scaled_x =+  T.mkVariable tRandom 1400014 1430036 3 0 "scaled_x" Prelude.True
+ Hat/RandomBuiltin.hs view
@@ -0,0 +1,14 @@+module Hat.RandomBuiltin(StdGen,module Hat.RandomBuiltin) where++import Hat.Hat as T+import System.Random++toStdGen :: RefExp -> R StdGen -> StdGen+toStdGen h (R v _) = v++fromStdGen :: RefExp -> StdGen -> R StdGen+fromStdGen h v = R v (T.mkValueUse h mkNoSrcPos aStdGen)++aStdGen :: RefAtom+aStdGen = mkAbstract "StdGen"+
+ Hat/Ratio.hs view
@@ -0,0 +1,14 @@+module Hat.Ratio+  (Ratio(),Rational(),(!%),(+%),(*%),gnumerator,anumerator,hnumerator+    ,gdenominator,adenominator,hdenominator,gapproxRational,aapproxRational+    ,happroxRational) where++import qualified Hat.PreludeBasic +import qualified Prelude +import Hat.Hack +import qualified Hat.Hat as T +import Hat.Hat  (WrapVal(wrapVal))+import Hat.Prelude +import Hat.PreludeBasic ++tRatio = T.mkModule "Ratio" "Ratio.hs" Prelude.False
+ Hat/System.hs view
@@ -0,0 +1,79 @@+module Hat.System+  (ExitCode(ExitSuccess,ExitFailure),aExitSuccess,aExitFailure,ggetArgs+    ,ggetProgName,ggetEnv,agetEnv,hgetEnv,gsystem,asystem,hsystem,gexitWith+    ,aexitWith,hexitWith,gexitFailure) where++import qualified Hat.PreludeBasic +import qualified Prelude +import Hat.Hack +import qualified Hat.Hat as T +import Hat.Hat  (WrapVal(wrapVal))+import Hat.Prelude +import Hat.PreludeBuiltinTypes +import Hat.SystemBuiltinTypes +import Hat.SystemBuiltin +import qualified System.Cmd as Cmd +import qualified System.Environment as Environment +import qualified System.Exit as Exit ++ggetArgs :: T.RefSrcPos -> T.RefExp -> T.R (IO (T.List String))++ggetArgs pgetArgs p = T.uconstUse pgetArgs p sgetArgs++sgetArgs =+  T.uconstDef T.mkRoot agetArgs+    (\ p -> (T.fromIO (fromList fromString)) p Environment.getArgs)++ggetProgName :: T.RefSrcPos -> T.RefExp -> T.R (IO String)++ggetProgName pgetProgName p = T.uconstUse pgetProgName p sgetProgName++sgetProgName =+  T.uconstDef T.mkRoot agetProgName+    (\ p -> (T.fromIO fromString) p Environment.getProgName)++ggetEnv :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun String (IO String))++ggetEnv pgetEnv p = T.ufun1 agetEnv pgetEnv p hgetEnv++hgetEnv z1getEnv kgetEnv =+  (T.fromIO fromString) kgetEnv (Environment.getEnv (toString kgetEnv z1getEnv))++gsystem :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun String (IO ExitCode))++gsystem psystem p = T.ufun1 asystem psystem p hsystem++hsystem z1system ksystem =+  (T.fromIO fromExitCode) ksystem (Cmd.system (toString ksystem z1system))++gexitWith :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun ExitCode (IO a))++gexitWith pexitWith p = T.ufun1 aexitWith pexitWith p hexitWith++hexitWith z1exitWith kexitWith =+  (T.fromIO T.fromId) kexitWith+    (Exit.exitWith (toExitCode kexitWith z1exitWith))++gexitFailure :: T.RefSrcPos -> T.RefExp -> T.R (IO a)++gexitFailure pexitFailure p = T.uconstUse pexitFailure p sexitFailure++sexitFailure =+  T.uconstDef T.mkRoot aexitFailure+    (\ p -> (T.fromIO T.fromId) p Exit.exitFailure)++tSystem = T.mkModule "System" "System.hs" Prelude.False++agetArgs = T.mkVariable tSystem 130001 140014 3 0 "getArgs" Prelude.False++agetProgName =+  T.mkVariable tSystem 150001 160018 3 0 "getProgName" Prelude.False++agetEnv = T.mkVariable tSystem 170001 180023 3 1 "getEnv" Prelude.False++asystem = T.mkVariable tSystem 190001 200023 3 1 "system" Prelude.False++aexitWith = T.mkVariable tSystem 210001 220027 3 1 "exitWith" Prelude.False++aexitFailure =+  T.mkVariable tSystem 230001 240018 3 0 "exitFailure" Prelude.False
+ Hat/SystemBuiltin.hs view
@@ -0,0 +1,17 @@+module Hat.SystemBuiltin where++import Hat.Hat as T+import Hat.SystemBuiltinTypes+import Hat.PreludeBuiltinTypes+import qualified System.Exit++toExitCode :: RefExp -> R ExitCode -> System.Exit.ExitCode+toExitCode h (R ExitSuccess _) = System.Exit.ExitSuccess+toExitCode h (R (ExitFailure rnum) _) = System.Exit.ExitFailure (toInt h rnum)++fromExitCode :: RefExp -> System.Exit.ExitCode -> R ExitCode+fromExitCode h System.Exit.ExitSuccess = +  T.con0 mkNoSrcPos h ExitSuccess aExitSuccess+fromExitCode h (System.Exit.ExitFailure num) =+  T.con1 mkNoSrcPos h ExitFailure aExitFailure +    (T.wrapForward h (fromInt h num))
+ Hat/SystemBuiltinTypes.hs view
@@ -0,0 +1,164 @@+module Hat.SystemBuiltinTypes (ExitCode(..),aExitSuccess,aExitFailure) where++import qualified Hat.PreludeBasic +import qualified Prelude +import Hat.Hack +import qualified Hat.Hat as T +import Hat.Hat  (WrapVal(wrapVal))+import Hat.Prelude ++data ExitCode = ExitSuccess  | ExitFailure (T.R Int)++instance T.WrapVal (ExitCode)+  where+  +  wrapVal pwrapVal (kwrapVal@ExitSuccess) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aExitSuccess)+  wrapVal pwrapVal (kwrapVal@(ExitFailure (T.R _ z1wrapVal))) p =+    T.R kwrapVal (T.mkValueApp1 p pwrapVal aExitFailure z1wrapVal)+  ++instance Eq (ExitCode)+  where+  +  (!==) (%==) p =+    T.ufun2 (+&=$^=&=$@==) (%==) p (*==)+    where+    +    (*==) (T.R ExitSuccess _) (T.R ExitSuccess _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R (ExitFailure fy1) _) (T.R (ExitFailure fy2) _) p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fy1 fy2+    (*==) _ _ p = T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse+    +  ++instance Ord (ExitCode)+  where+  +  gcompare pcompare p =+    T.ufun2 a4v31v4v33compare pcompare p hcompare+    where+    +    hcompare (T.R (ExitFailure fy3) _) (T.R (ExitFailure fy4) _) p =+      T.uap2 T.mkNoSrcPos p (Hat.Prelude.gcompare T.mkNoSrcPos p) fy3 fy4+    hcompare fy1 fy2 p =+      T.uap2 T.mkNoSrcPos p (Hat.Prelude.gcompare T.mkNoSrcPos p)+        (T.uwrapForward p (hlocalFromEnum fy1 p) :: T.R Hat.Prelude.Int)+        (T.uwrapForward p (hlocalFromEnum fy2 p))+      where+      +      glocalFromEnum plocalFromEnum p =+        T.ufun1 a4v31v4v33localFromEnum plocalFromEnum p hlocalFromEnum+      +      alocalFromEnum = a4v31v4v33localFromEnum+      +      hlocalFromEnum (T.R (ExitSuccess) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0)+      hlocalFromEnum (T.R (ExitFailure _) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 1)+      hlocalFromEnum _ p = T.fatal p+      +    +  ++instance Read (ExitCode)+  where+  +  greadsPrec preadsPrec p =+    T.ufun1 a4v36v4v39readsPrec preadsPrec p hreadsPrec+    where+    +    hreadsPrec fy1 p =+      T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.galt T.mkNoSrcPos p)+        (T.uwrapForward p+          (Hat.Prelude.hreadParen+            (T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse)+            (T.uwrapForward p+              (Hat.PreludeBasic.hthenLex+                (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                  (T.con0 T.mkNoSrcPos p ExitSuccess aExitSuccess))+                (T.fromLitString T.mkNoSrcPos p "ExitSuccess") p)) p))+        (T.uwrapForward p+          (Hat.Prelude.hreadParen+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!> p) fy1+              (T.uap1 T.mkNoSrcPos p+                (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                (T.conInteger T.mkNoSrcPos p 9)))+            (T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.gthenAp T.mkNoSrcPos p)+              (T.uwrapForward p+                (Hat.PreludeBasic.hthenLex+                  (T.uap1 T.mkNoSrcPos p+                    (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                    (T.pa0 ExitFailure T.cn1 T.mkNoSrcPos p aExitFailure))+                  (T.fromLitString T.mkNoSrcPos p "ExitFailure") p))+              (T.uap1 T.mkNoSrcPos p (Hat.Prelude.greadsPrec T.mkNoSrcPos p)+                (T.uap1 T.mkNoSrcPos p+                  (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                  (T.conInteger T.mkNoSrcPos p 10)))) p))+    +  ++instance Show (ExitCode)+  where+  +  gshowsPrec pshowsPrec p =+    T.ufun2 a4v42v4v45showsPrec pshowsPrec p hshowsPrec+    where+    +    hshowsPrec fy1 (T.R (ExitSuccess) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "ExitSuccess")+    hshowsPrec fy1 (T.R (ExitFailure fy2) _) p =+      T.uwrapForward p+        (Hat.Prelude.hshowParen+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!> p) fy1+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 9)))+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+            (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+              (T.fromLitString T.mkNoSrcPos p "ExitFailure "))+            (T.uap2 T.mkNoSrcPos p (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+              (T.uap1 T.mkNoSrcPos p+                (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                (T.conInteger T.mkNoSrcPos p 10)) fy2)) p)+    hshowsPrec _ _ p = T.fatal p+    +  ++tSystemBuiltinTypes =+  T.mkModule "SystemBuiltinTypes" "SystemBuiltinTypes.hs" Prelude.True++aExitSuccess = T.mkConstructor tSystemBuiltinTypes 30017 30027 3 0 "ExitSuccess"++aExitFailure = T.mkConstructor tSystemBuiltinTypes 30031 30041 3 1 "ExitFailure"++(+&=$^=&=$@==) =+  T.mkVariable tSystemBuiltinTypes 40027 40028 3 2 "==" Prelude.False++a4v31v4v33compare =+  T.mkVariable tSystemBuiltinTypes 40031 40033 3 2 "compare" Prelude.False++a4v36v4v39readsPrec =+  T.mkVariable tSystemBuiltinTypes 40036 40039 3 1 "readsPrec" Prelude.False++a4v42v4v45showsPrec =+  T.mkVariable tSystemBuiltinTypes 40042 40045 3 2 "showsPrec" Prelude.False++a4v31v4v33localFromEnum =+  T.mkVariable tSystemBuiltinTypes 40031 40033 3 1 "localFromEnum" Prelude.True++p3v17v3v27 = T.mkSrcPos tSystemBuiltinTypes 30017 30027++p3v31v3v41 = T.mkSrcPos tSystemBuiltinTypes 30031 30041++p4v27v4v28 = T.mkSrcPos tSystemBuiltinTypes 40027 40028++p4v31v4v33 = T.mkSrcPos tSystemBuiltinTypes 40031 40033++p4v36v4v39 = T.mkSrcPos tSystemBuiltinTypes 40036 40039++p4v42v4v45 = T.mkSrcPos tSystemBuiltinTypes 40042 40045
+ Hat/Time.hs view
@@ -0,0 +1,224 @@+module Hat.Time+  (ClockTime(),Month(January,February,March,April,May,June,July,August,September+      ,October,November,December),aJanuary,aFebruary,aMarch,aApril,aMay,aJune+    ,aJuly,aAugust,aSeptember,aOctober,aNovember,aDecember,Day(Sunday,Monday+      ,Tuesday,Wednesday,Thursday,Friday,Saturday),aSunday,aMonday,aTuesday+    ,aWednesday,aThursday,aFriday,aSaturday,CalendarTime(CalendarTime,bctYear+      ,bctMonth,bctDay,bctHour,bctMin,bctSec,bctPicosec,bctWDay,bctYDay+      ,bctTZName,bctTZ,bctIsDST),gctYear,gctMonth,gctDay,gctHour,gctMin,gctSec+    ,gctPicosec,gctWDay,gctYDay,gctTZName,gctTZ,gctIsDST,hctYear,hctMonth,hctDay+    ,hctHour,hctMin,hctSec,hctPicosec,hctWDay,hctYDay,hctTZName,hctTZ,hctIsDST+    ,actYear,actMonth,actDay,actHour,actMin,actSec,actPicosec,actWDay,actYDay+    ,actTZName,actTZ,actIsDST,aCalendarTime,TimeDiff(TimeDiff,btdYear,btdMonth+      ,btdDay,btdHour,btdMin,btdSec,btdPicosec),gtdYear,gtdMonth,gtdDay,gtdHour+    ,gtdMin,gtdSec,gtdPicosec,htdYear,htdMonth,htdDay,htdHour,htdMin,htdSec+    ,htdPicosec,atdYear,atdMonth,atdDay,atdHour,atdMin,atdSec,atdPicosec+    ,aTimeDiff,ggetClockTime,gaddToClockTime,aaddToClockTime,haddToClockTime+    ,gdiffClockTimes,adiffClockTimes,hdiffClockTimes,gtoCalendarTime+    ,atoCalendarTime,htoCalendarTime,gtoUTCTime,atoUTCTime,htoUTCTime+    ,gtoClockTime,atoClockTime,htoClockTime,gcalendarTimeToString+    ,acalendarTimeToString,hcalendarTimeToString,gformatCalendarTime+    ,aformatCalendarTime,hformatCalendarTime) where++import qualified Hat.PreludeBasic +import qualified Prelude +import Hat.Hack +import qualified Hat.Hat as T +import Hat.Hat  (WrapVal(wrapVal))+import Hat.Prelude +import Hat.Ix  (Ix())+import Hat.Locale  (TimeLocale(TimeLocale,bwDays,bmonths,bamPm,bdateTimeFmt+    ,bdateFmt,btimeFmt,btime12Fmt),gwDays,gmonths,gamPm,gdateTimeFmt,gdateFmt+  ,gtimeFmt,gtime12Fmt,hwDays,hmonths,hamPm,hdateTimeFmt,hdateFmt,htimeFmt+  ,htime12Fmt,awDays,amonths,aamPm,adateTimeFmt,adateFmt,atimeFmt,atime12Fmt+  ,aTimeLocale,gdefaultTimeLocale)+import Hat.Char  (gintToDigit,aintToDigit,hintToDigit)+import Hat.PreludeBuiltinTypes +import Hat.TimeBuiltinTypes +import Hat.TimeBuiltin +import qualified System.Time as Time ++instance Ord (ClockTime)+  where+  +  gcompare pcompare p = T.uconstUse pcompare p scompare+  +  scompare =+    T.uconstDef T.mkRoot a28v3v28v32compare+      (\ p -> gprimClockTimeCompare T.mkNoSrcPos p)+  +  (!<=) (%<=) p = T.uconstUse (%<=) p (|<=)+  +  (|<=) =+    T.uconstDef T.mkRoot (+$>=&=$>=$+<=)+      (\ p -> gprimClockTimeLeEq T.mkNoSrcPos p)+  ++instance Eq (ClockTime)+  where+  +  (!==) (%==) p = T.uconstUse (%==) p (|==)+  +  (|==) =+    T.uconstDef T.mkRoot (+%$=&=%$=$+==)+      (\ p -> gprimClockTimeEqEq T.mkNoSrcPos p)+  ++gprimClockTimeCompare ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun ClockTime (T.Fun ClockTime Ordering))++gprimClockTimeCompare pprimClockTimeCompare p =+  T.ufun2 aprimClockTimeCompare pprimClockTimeCompare p hprimClockTimeCompare++hprimClockTimeCompare z1primClockTimeCompare z2primClockTimeCompare+  kprimClockTimeCompare =+  fromOrdering kprimClockTimeCompare+    (Prelude.compare (toClockTime kprimClockTimeCompare z1primClockTimeCompare)+      (toClockTime kprimClockTimeCompare z2primClockTimeCompare))++gprimClockTimeLeEq ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun ClockTime (T.Fun ClockTime Bool))++gprimClockTimeLeEq pprimClockTimeLeEq p =+  T.ufun2 aprimClockTimeLeEq pprimClockTimeLeEq p hprimClockTimeLeEq++hprimClockTimeLeEq z1primClockTimeLeEq z2primClockTimeLeEq kprimClockTimeLeEq =+  fromBool kprimClockTimeLeEq+    ((toClockTime kprimClockTimeLeEq z1primClockTimeLeEq)+      Prelude.<=+      (toClockTime kprimClockTimeLeEq z2primClockTimeLeEq))++gprimClockTimeEqEq ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun ClockTime (T.Fun ClockTime Bool))++gprimClockTimeEqEq pprimClockTimeEqEq p =+  T.ufun2 aprimClockTimeEqEq pprimClockTimeEqEq p hprimClockTimeEqEq++hprimClockTimeEqEq z1primClockTimeEqEq z2primClockTimeEqEq kprimClockTimeEqEq =+  fromBool kprimClockTimeEqEq+    ((toClockTime kprimClockTimeEqEq z1primClockTimeEqEq)+      Prelude.==+      (toClockTime kprimClockTimeEqEq z2primClockTimeEqEq))++ggetClockTime :: T.RefSrcPos -> T.RefExp -> T.R (IO ClockTime)++ggetClockTime pgetClockTime p = T.uconstUse pgetClockTime p sgetClockTime++sgetClockTime =+  T.uconstDef T.mkRoot agetClockTime+    (\ p -> (T.fromIO fromClockTime) p Time.getClockTime)++gaddToClockTime ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun TimeDiff (T.Fun ClockTime ClockTime))++gaddToClockTime paddToClockTime p =+  T.ufun2 aaddToClockTime paddToClockTime p haddToClockTime++haddToClockTime z1addToClockTime z2addToClockTime kaddToClockTime =+  fromClockTime kaddToClockTime+    (Time.addToClockTime (toTimeDiff kaddToClockTime z1addToClockTime)+      (toClockTime kaddToClockTime z2addToClockTime))++gdiffClockTimes ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun ClockTime (T.Fun ClockTime TimeDiff))++gdiffClockTimes pdiffClockTimes p =+  T.ufun2 adiffClockTimes pdiffClockTimes p hdiffClockTimes++hdiffClockTimes z1diffClockTimes z2diffClockTimes kdiffClockTimes =+  fromTimeDiff kdiffClockTimes+    (Time.diffClockTimes (toClockTime kdiffClockTimes z1diffClockTimes)+      (toClockTime kdiffClockTimes z2diffClockTimes))++gtoCalendarTime ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun ClockTime (IO CalendarTime))++gtoCalendarTime ptoCalendarTime p =+  T.ufun1 atoCalendarTime ptoCalendarTime p htoCalendarTime++htoCalendarTime z1toCalendarTime ktoCalendarTime =+  (T.fromIO fromCalendarTime) ktoCalendarTime+    (Time.toCalendarTime (toClockTime ktoCalendarTime z1toCalendarTime))++gtoUTCTime :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun ClockTime CalendarTime)++gtoUTCTime ptoUTCTime p = T.ufun1 atoUTCTime ptoUTCTime p htoUTCTime++htoUTCTime z1toUTCTime ktoUTCTime =+  fromCalendarTime ktoUTCTime+    (Time.toUTCTime (toClockTime ktoUTCTime z1toUTCTime))++gtoClockTime :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun CalendarTime ClockTime)++gtoClockTime ptoClockTime p = T.ufun1 atoClockTime ptoClockTime p htoClockTime++htoClockTime z1toClockTime ktoClockTime =+  fromClockTime ktoClockTime+    (Time.toClockTime (toCalendarTime ktoClockTime z1toClockTime))++gcalendarTimeToString ::+  T.RefSrcPos -> T.RefExp -> T.R (T.Fun CalendarTime String)++gcalendarTimeToString pcalendarTimeToString p =+  T.ufun1 acalendarTimeToString pcalendarTimeToString p hcalendarTimeToString++hcalendarTimeToString z1calendarTimeToString kcalendarTimeToString =+  fromString kcalendarTimeToString+    (Time.calendarTimeToString+      (toCalendarTime kcalendarTimeToString z1calendarTimeToString))++gformatCalendarTime ::+  T.RefSrcPos ->+    T.RefExp ->+      T.R (T.Fun TimeLocale (T.Fun String (T.Fun CalendarTime String)))++gformatCalendarTime pformatCalendarTime p =+  T.ufun3 aformatCalendarTime pformatCalendarTime p hformatCalendarTime++hformatCalendarTime z1formatCalendarTime z2formatCalendarTime+  z3formatCalendarTime kformatCalendarTime =+  fromString kformatCalendarTime+    (Time.formatCalendarTime+      (toTimeLocale kformatCalendarTime z1formatCalendarTime)+      (toString kformatCalendarTime z2formatCalendarTime)+      (toCalendarTime kformatCalendarTime z3formatCalendarTime))++tTime = T.mkModule "Time" "Time.hs" Prelude.False++aprimClockTimeCompare =+  T.mkVariable tTime 340001 350059 3 2 "primClockTimeCompare" Prelude.False++aprimClockTimeLeEq =+  T.mkVariable tTime 370001 380052 3 2 "primClockTimeLeEq" Prelude.False++aprimClockTimeEqEq =+  T.mkVariable tTime 400001 410052 3 2 "primClockTimeEqEq" Prelude.False++agetClockTime =+  T.mkVariable tTime 430001 440030 3 0 "getClockTime" Prelude.False++aaddToClockTime =+  T.mkVariable tTime 460001 470066 3 2 "addToClockTime" Prelude.False++adiffClockTimes =+  T.mkVariable tTime 490001 500065 3 2 "diffClockTimes" Prelude.False++atoCalendarTime =+  T.mkVariable tTime 520001 530046 3 1 "toCalendarTime" Prelude.False++atoUTCTime = T.mkVariable tTime 550001 560056 3 1 "toUTCTime" Prelude.False++atoClockTime = T.mkVariable tTime 580001 590053 3 1 "toClockTime" Prelude.False++acalendarTimeToString =+  T.mkVariable tTime 610001 620050 3 1 "calendarTimeToString" Prelude.False++aformatCalendarTime =+  T.mkVariable tTime 640001 650069 3 3 "formatCalendarTime" Prelude.False++a28v3v28v32compare =+  T.mkVariable tTime 280003 280032 3 0 "compare" Prelude.False++(+$>=&=$>=$+<=) = T.mkVariable tTime 290004 290026 16 0 "<=" Prelude.False++(+%$=&=%$=$+==) = T.mkVariable tTime 320004 320026 16 0 "==" Prelude.False
+ Hat/TimeBuiltin.hs view
@@ -0,0 +1,121 @@+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+module Hat.TimeBuiltin(ClockTime,module Hat.TimeBuiltin) where++import Hat.Hat as T+import Hat.PreludeBuiltinTypes+import Hat.Prelude+import Hat.TimeBuiltinTypes+import qualified System.Time as Time+import System.Time(ClockTime)+import qualified System.Locale as Locale+import Hat.Locale++toClockTime :: RefExp -> R ClockTime -> Time.ClockTime+toClockTime h (R v _) = v++fromClockTime :: RefExp -> Time.ClockTime -> R ClockTime+fromClockTime h v = R v (T.mkValueUse h mkNoSrcPos aClockTime)++aClockTime :: RefAtom+aClockTime = mkAbstract "ClockTime"+++toMonth :: RefExp -> R Month -> Time.Month+toMonth h (R January _) = Time.January+toMonth h (R February _) = Time.February+toMonth h (R March _) = Time.March+toMonth h (R April _) = Time.April+toMonth h (R May _) = Time.May+toMonth h (R June _) = Time.June+toMonth h (R July _) = Time.July+toMonth h (R August _) = Time.August+toMonth h (R September _) = Time.September+toMonth h (R October _) = Time.October+toMonth h (R November _) = Time.November+toMonth h (R December _) = Time.December++fromMonth :: RefExp -> Time.Month -> R Month+fromMonth h Time.January = T.con0 mkNoSrcPos h January aJanuary+fromMonth h Time.February = T.con0 mkNoSrcPos h February aFebruary +fromMonth h Time.March = T.con0 mkNoSrcPos h March aMarch +fromMonth h Time.April = T.con0 mkNoSrcPos h April aApril+fromMonth h Time.May = T.con0 mkNoSrcPos h May aMay+fromMonth h Time.June = T.con0 mkNoSrcPos h June aJune+fromMonth h Time.July = T.con0 mkNoSrcPos h July aJuly+fromMonth h Time.August = T.con0 mkNoSrcPos h August aAugust+fromMonth h Time.September = T.con0 mkNoSrcPos h September aSeptember+fromMonth h Time.October = T.con0 mkNoSrcPos h October aOctober+fromMonth h Time.November = T.con0 mkNoSrcPos h November aNovember+fromMonth h Time.December = T.con0 mkNoSrcPos h December aDecember++toDay :: RefExp -> R Day -> Time.Day+toDay h (R Sunday _) = Time.Sunday+toDay h (R Monday _) = Time.Monday+toDay h (R Tuesday _) = Time.Tuesday+toDay h (R Wednesday _) = Time.Wednesday+toDay h (R Thursday _) = Time.Thursday+toDay h (R Friday _) = Time.Friday+toDay h (R Saturday _) = Time.Saturday++fromDay :: RefExp -> Time.Day -> R Day+fromDay h Time.Sunday = T.con0 mkNoSrcPos h Sunday aSunday+fromDay h Time.Monday = T.con0 mkNoSrcPos h Monday aMonday+fromDay h Time.Tuesday = T.con0 mkNoSrcPos h Tuesday aTuesday+fromDay h Time.Wednesday = T.con0 mkNoSrcPos h Wednesday aWednesday+fromDay h Time.Thursday = T.con0 mkNoSrcPos h Thursday aThursday+fromDay h Time.Friday = T.con0 mkNoSrcPos h Friday aFriday+fromDay h Time.Saturday = T.con0 mkNoSrcPos h Saturday aSaturday++toCalendarTime :: RefExp -> R CalendarTime -> Time.CalendarTime+toCalendarTime h +  (R (CalendarTime year month day hour min sec picosec wday yday tzname tz +       isdst) _) =+  Time.CalendarTime (toInt h year) (toMonth h month) (toInt h day) +    (toInt h hour) (toInt h min) (toInt h sec) +    (T.toInteger h picosec) +    (toDay h wday) (toInt h yday) (toString h tzname) (toInt h tz) +    (toBool h isdst)++fromCalendarTime :: RefExp -> Time.CalendarTime -> R CalendarTime+fromCalendarTime h +  (Time.CalendarTime year month day hour min sec picosec wday yday tzname tz +    isdst) =+  T.con12 mkNoSrcPos h CalendarTime aCalendarTime +    (T.wrapForward h (fromInt h year)) (T.wrapForward h (fromMonth h month))+    (T.wrapForward h (fromInt h day))  (T.wrapForward h (fromInt h hour))+    (T.wrapForward h (fromInt h min)) (T.wrapForward h (fromInt h sec)) +    (T.wrapForward h (T.fromInteger h picosec))+    (T.wrapForward h (fromDay h wday)) (T.wrapForward h (fromInt h yday))+    (T.wrapForward h (fromString h tzname)) (T.wrapForward h (fromInt h tz)) +    (T.wrapForward h (fromBool h isdst))++toTimeDiff :: RefExp -> R TimeDiff -> Time.TimeDiff+toTimeDiff h (R (TimeDiff year month day hour min sec picosec) _) =+  Time.TimeDiff (toInt h year) (toInt h month) (toInt h day) +    (toInt h hour) (toInt h min) (toInt h sec) +    (T.toInteger h picosec)++fromTimeDiff :: RefExp -> Time.TimeDiff -> R TimeDiff+fromTimeDiff h (Time.TimeDiff year month day hour min sec picosec) =+  T.con7 mkNoSrcPos h TimeDiff aTimeDiff +    (T.wrapForward h (fromInt h year)) (T.wrapForward h (fromInt h month))+    (T.wrapForward h (fromInt h day)) +    (T.wrapForward h (fromInt h hour)) (T.wrapForward h (fromInt h min)) +    (T.wrapForward h (fromInt h sec)) +    (T.wrapForward h (T.fromInteger h picosec))++toTimeLocale :: RefExp -> R TimeLocale -> Locale.TimeLocale+toTimeLocale h +  (R (TimeLocale twDays tmonths tamPm tdateTimeFmt tdateFmt ttimeFmt +       ttime12Fmt) _) =+  Locale.TimeLocale{Locale.wDays=(toList (toTuple2 toString toString) h twDays)+    ,Locale.months=(toList (toTuple2 toString toString) h tmonths) +    ,Locale.amPm=(toTuple2 toString toString h tamPm)+    ,Locale.dateTimeFmt=(toString h tdateTimeFmt)+    ,Locale.dateFmt=(toString h tdateFmt),Locale.timeFmt=(toString h ttimeFmt)+    ,Locale.time12Fmt=(toString h ttime12Fmt)}++fromOrdering :: RefExp -> Prelude.Ordering -> R Hat.Prelude.Ordering+fromOrdering h Prelude.LT = T.con0 mkNoSrcPos h Hat.Prelude.LT aLT+fromOrdering h Prelude.EQ = T.con0 mkNoSrcPos h Hat.Prelude.EQ aLT+fromOrdering h Prelude.GT = T.con0 mkNoSrcPos h Hat.Prelude.GT aLT
+ Hat/TimeBuiltinTypes.hs view
@@ -0,0 +1,3406 @@+module Hat.TimeBuiltinTypes+  (Month(..),Day(..),CalendarTime(..),gctYear,hctYear,gctMonth,hctMonth,gctDay+    ,hctDay,gctHour,hctHour,gctMin,hctMin,gctSec,hctSec,gctPicosec,hctPicosec+    ,gctWDay,hctWDay,gctYDay,hctYDay,gctTZName,hctTZName,gctTZ,hctTZ,gctIsDST+    ,hctIsDST,TimeDiff(..),gtdYear,htdYear,gtdMonth,htdMonth,gtdDay,htdDay+    ,gtdHour,htdHour,gtdMin,htdMin,gtdSec,htdSec,gtdPicosec,htdPicosec,aJanuary+    ,aFebruary,aMarch,aApril,aMay,aJune,aJuly,aAugust,aSeptember,aOctober+    ,aNovember,aDecember,aSunday,aMonday,aTuesday,aWednesday,aThursday,aFriday+    ,aSaturday,aCalendarTime,aTimeDiff,actYear,actMonth,actDay,actHour,actMin+    ,actSec,actPicosec,actWDay,actYDay,actTZName,actTZ,actIsDST,atdYear,atdMonth+    ,atdDay,atdHour,atdMin,atdSec,atdPicosec) where++import qualified Hat.PreludeBasic +import qualified Prelude +import Hat.Hack +import qualified Hat.Hat as T +import Hat.Hat  (WrapVal(wrapVal))+import Hat.Prelude +import Hat.Ix  (Ix(..))++data Month =+  January  | February  | March  | April  | May  | June  | July  | August +  | September  | October  | November  | December ++instance T.WrapVal (Month)+  where+  +  wrapVal pwrapVal (kwrapVal@January) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aJanuary)+  wrapVal pwrapVal (kwrapVal@February) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aFebruary)+  wrapVal pwrapVal (kwrapVal@March) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aMarch)+  wrapVal pwrapVal (kwrapVal@April) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aApril)+  wrapVal pwrapVal (kwrapVal@May) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aMay)+  wrapVal pwrapVal (kwrapVal@June) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aJune)+  wrapVal pwrapVal (kwrapVal@July) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aJuly)+  wrapVal pwrapVal (kwrapVal@August) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aAugust)+  wrapVal pwrapVal (kwrapVal@September) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aSeptember)+  wrapVal pwrapVal (kwrapVal@October) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aOctober)+  wrapVal pwrapVal (kwrapVal@November) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aNovember)+  wrapVal pwrapVal (kwrapVal@December) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aDecember)+  ++instance Eq (Month)+  where+  +  (!==) (%==) p =+    T.ufun2 (+@=$$=@=$%==) (%==) p (*==)+    where+    +    (*==) (T.R January _) (T.R January _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R February _) (T.R February _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R March _) (T.R March _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R April _) (T.R April _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R May _) (T.R May _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R June _) (T.R June _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R July _) (T.R July _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R August _) (T.R August _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R September _) (T.R September _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R October _) (T.R October _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R November _) (T.R November _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R December _) (T.R December _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) _ _ p = T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse+    +  ++instance Ord (Month)+  where+  +  gcompare pcompare p =+    T.ufun2 a8v26v8v28compare pcompare p hcompare+    where+    +    hcompare fy1 fy2 p =+      T.uap2 T.mkNoSrcPos p (Hat.Prelude.gcompare T.mkNoSrcPos p)+        (T.uwrapForward p (hlocalFromEnum fy1 p) :: T.R Hat.Prelude.Int)+        (T.uwrapForward p (hlocalFromEnum fy2 p))+      where+      +      glocalFromEnum plocalFromEnum p =+        T.ufun1 a8v26v8v28localFromEnum plocalFromEnum p hlocalFromEnum+      +      alocalFromEnum = a8v26v8v28localFromEnum+      +      hlocalFromEnum (T.R (January) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0)+      hlocalFromEnum (T.R (February) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 1)+      hlocalFromEnum (T.R (March) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 2)+      hlocalFromEnum (T.R (April) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 3)+      hlocalFromEnum (T.R (May) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 4)+      hlocalFromEnum (T.R (June) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 5)+      hlocalFromEnum (T.R (July) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 6)+      hlocalFromEnum (T.R (August) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 7)+      hlocalFromEnum (T.R (September) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 8)+      hlocalFromEnum (T.R (October) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 9)+      hlocalFromEnum (T.R (November) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 10)+      hlocalFromEnum (T.R (December) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 11)+      hlocalFromEnum _ p = T.fatal p+      +    +  ++instance Enum (Month)+  where+  +  gfromEnum pfromEnum p =+    T.ufun1 a8v31v8v34fromEnum pfromEnum p hfromEnum+    where+    +    hfromEnum (T.R January _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 0)+    hfromEnum (T.R February _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 1)+    hfromEnum (T.R March _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 2)+    hfromEnum (T.R April _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 3)+    hfromEnum (T.R May _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 4)+    hfromEnum (T.R June _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 5)+    hfromEnum (T.R July _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 6)+    hfromEnum (T.R August _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 7)+    hfromEnum (T.R September _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 8)+    hfromEnum (T.R October _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 9)+    hfromEnum (T.R November _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 10)+    hfromEnum (T.R December _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 11)+    hfromEnum _ p = T.fatal p+    +  +  gtoEnum ptoEnum p =+    T.ufun1 a8v31v8v34toEnum ptoEnum p htoEnum+    where+    +    htoEnum fv8v31v8v34n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv8v31v8v34n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 0))) (h p) (y1toEnum fv8v31v8v34n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p January aJanuary+      h p = y1toEnum fv8v31v8v34n p+      +    htoEnum fv8v31v8v34n p = y1toEnum fv8v31v8v34n p+    +    y1toEnum fv8v31v8v34n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv8v31v8v34n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 1))) (h p) (y2toEnum fv8v31v8v34n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p February aFebruary+      h p = y2toEnum fv8v31v8v34n p+      +    y1toEnum fv8v31v8v34n p = y2toEnum fv8v31v8v34n p+    +    y2toEnum fv8v31v8v34n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv8v31v8v34n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 2))) (h p) (y3toEnum fv8v31v8v34n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p March aMarch+      h p = y3toEnum fv8v31v8v34n p+      +    y2toEnum fv8v31v8v34n p = y3toEnum fv8v31v8v34n p+    +    y3toEnum fv8v31v8v34n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv8v31v8v34n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 3))) (h p) (y4toEnum fv8v31v8v34n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p April aApril+      h p = y4toEnum fv8v31v8v34n p+      +    y3toEnum fv8v31v8v34n p = y4toEnum fv8v31v8v34n p+    +    y4toEnum fv8v31v8v34n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv8v31v8v34n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 4))) (h p) (y5toEnum fv8v31v8v34n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p May aMay+      h p = y5toEnum fv8v31v8v34n p+      +    y4toEnum fv8v31v8v34n p = y5toEnum fv8v31v8v34n p+    +    y5toEnum fv8v31v8v34n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv8v31v8v34n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 5))) (h p) (y6toEnum fv8v31v8v34n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p June aJune+      h p = y6toEnum fv8v31v8v34n p+      +    y5toEnum fv8v31v8v34n p = y6toEnum fv8v31v8v34n p+    +    y6toEnum fv8v31v8v34n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv8v31v8v34n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 6))) (h p) (y7toEnum fv8v31v8v34n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p July aJuly+      h p = y7toEnum fv8v31v8v34n p+      +    y6toEnum fv8v31v8v34n p = y7toEnum fv8v31v8v34n p+    +    y7toEnum fv8v31v8v34n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv8v31v8v34n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 7))) (h p) (y8toEnum fv8v31v8v34n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p August aAugust+      h p = y8toEnum fv8v31v8v34n p+      +    y7toEnum fv8v31v8v34n p = y8toEnum fv8v31v8v34n p+    +    y8toEnum fv8v31v8v34n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv8v31v8v34n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 8))) (h p) (y9toEnum fv8v31v8v34n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p September aSeptember+      h p = y9toEnum fv8v31v8v34n p+      +    y8toEnum fv8v31v8v34n p = y9toEnum fv8v31v8v34n p+    +    y9toEnum fv8v31v8v34n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv8v31v8v34n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 9))) (h p) (y10toEnum fv8v31v8v34n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p October aOctober+      h p = y10toEnum fv8v31v8v34n p+      +    y9toEnum fv8v31v8v34n p = y10toEnum fv8v31v8v34n p+    +    y10toEnum fv8v31v8v34n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv8v31v8v34n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 10))) (h p) (y11toEnum fv8v31v8v34n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p November aNovember+      h p = y11toEnum fv8v31v8v34n p+      +    y10toEnum fv8v31v8v34n p = y11toEnum fv8v31v8v34n p+    +    y11toEnum fv8v31v8v34n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv8v31v8v34n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 11))) (h p) (y12toEnum fv8v31v8v34n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p December aDecember+      h p = y12toEnum fv8v31v8v34n p+      +    y11toEnum fv8v31v8v34n p = y12toEnum fv8v31v8v34n p+    +    y12toEnum _ p =+      T.uwrapForward p+        (Hat.Prelude.herror+          (T.fromLitString T.mkNoSrcPos p "toEnum: argument out of bounds") p)+    +  +  genumFrom penumFrom p =+    T.ufun1 a8v31v8v34enumFrom penumFrom p henumFrom+    where+    +    henumFrom fy1 p =+      T.uap2 T.mkNoSrcPos p (Hat.Prelude.genumFromTo T.mkNoSrcPos p) fy1+        (T.con0 T.mkNoSrcPos p December aDecember)+    +  +  genumFromThen penumFromThen p =+    T.ufun2 a8v31v8v34enumFromThen penumFromThen p henumFromThen+    where+    +    henumFromThen fy1 fy2 p =+      T.uap3 T.mkNoSrcPos p (Hat.Prelude.genumFromThenTo T.mkNoSrcPos p) fy1 fy2+        (T.ucif p+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>= p)+            (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gfromEnum T.mkNoSrcPos p) fy1)+            (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gfromEnum T.mkNoSrcPos p) fy2))+          (T.con0 T.mkNoSrcPos p December aDecember)+          (T.con0 T.mkNoSrcPos p January aJanuary))+    +  ++instance Bounded (Month)+  where+  +  gminBound pminBound p = T.uconstUse pminBound p sminBound+  +  sminBound =+    T.uconstDef T.mkRoot a8v37v8v43minBound+      (\ p -> T.con0 T.mkNoSrcPos p January aJanuary)+  +  gmaxBound pmaxBound p = T.uconstUse pmaxBound p smaxBound+  +  smaxBound =+    T.uconstDef T.mkRoot a8v37v8v43maxBound+      (\ p -> T.con0 T.mkNoSrcPos p December aDecember)+  ++instance Ix (Month)+  where+  +  grange prange p =+    T.ufun1 a8v46v8v47range prange p hrange+    where+    +    hrange (T.R (T.Tuple2 fy1 fy2) _) p =+      T.uwrapForward p+        (Hat.PreludeBasic.hmap (glocalToEnum T.mkNoSrcPos p)+          (T.uap2 T.mkNoSrcPos p (Hat.Prelude.genumFromTo T.mkNoSrcPos p)+            (T.uwrapForward p (hlocalFromEnum fy1 p))+            (T.uwrapForward p (hlocalFromEnum fy2 p))) p)+      where+      +      glocalToEnum ::+        T.RefSrcPos -> T.RefExp -> T.R (T.Fun Hat.Prelude.Int Month)+      +      hlocalToEnum :: (T.R Hat.Prelude.Int) -> T.RefExp -> T.R Month+      +      glocalToEnum plocalToEnum p =+        T.ufun1 a8v46v8v47localToEnum plocalToEnum p hlocalToEnum+      +      alocalToEnum = a8v46v8v47localToEnum+      +      hlocalToEnum fv8v46v8v47n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv8v46v8v47n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 0))) (h p)+          (y1localToEnum fv8v46v8v47n p)+        where+        +        h p = T.con0 T.mkNoSrcPos p January aJanuary+        h p = y1localToEnum fv8v46v8v47n p+        +      hlocalToEnum fv8v46v8v47n p = y1localToEnum fv8v46v8v47n p+      +      y1localToEnum fv8v46v8v47n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv8v46v8v47n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 1))) (h p)+          (y2localToEnum fv8v46v8v47n p)+        where+        +        h p = T.con0 T.mkNoSrcPos p February aFebruary+        h p = y2localToEnum fv8v46v8v47n p+        +      y1localToEnum fv8v46v8v47n p = y2localToEnum fv8v46v8v47n p+      +      y2localToEnum fv8v46v8v47n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv8v46v8v47n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 2))) (h p)+          (y3localToEnum fv8v46v8v47n p)+        where+        +        h p = T.con0 T.mkNoSrcPos p March aMarch+        h p = y3localToEnum fv8v46v8v47n p+        +      y2localToEnum fv8v46v8v47n p = y3localToEnum fv8v46v8v47n p+      +      y3localToEnum fv8v46v8v47n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv8v46v8v47n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 3))) (h p)+          (y4localToEnum fv8v46v8v47n p)+        where+        +        h p = T.con0 T.mkNoSrcPos p April aApril+        h p = y4localToEnum fv8v46v8v47n p+        +      y3localToEnum fv8v46v8v47n p = y4localToEnum fv8v46v8v47n p+      +      y4localToEnum fv8v46v8v47n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv8v46v8v47n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 4))) (h p)+          (y5localToEnum fv8v46v8v47n p)+        where+        +        h p = T.con0 T.mkNoSrcPos p May aMay+        h p = y5localToEnum fv8v46v8v47n p+        +      y4localToEnum fv8v46v8v47n p = y5localToEnum fv8v46v8v47n p+      +      y5localToEnum fv8v46v8v47n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv8v46v8v47n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 5))) (h p)+          (y6localToEnum fv8v46v8v47n p)+        where+        +        h p = T.con0 T.mkNoSrcPos p June aJune+        h p = y6localToEnum fv8v46v8v47n p+        +      y5localToEnum fv8v46v8v47n p = y6localToEnum fv8v46v8v47n p+      +      y6localToEnum fv8v46v8v47n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv8v46v8v47n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 6))) (h p)+          (y7localToEnum fv8v46v8v47n p)+        where+        +        h p = T.con0 T.mkNoSrcPos p July aJuly+        h p = y7localToEnum fv8v46v8v47n p+        +      y6localToEnum fv8v46v8v47n p = y7localToEnum fv8v46v8v47n p+      +      y7localToEnum fv8v46v8v47n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv8v46v8v47n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 7))) (h p)+          (y8localToEnum fv8v46v8v47n p)+        where+        +        h p = T.con0 T.mkNoSrcPos p August aAugust+        h p = y8localToEnum fv8v46v8v47n p+        +      y7localToEnum fv8v46v8v47n p = y8localToEnum fv8v46v8v47n p+      +      y8localToEnum fv8v46v8v47n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv8v46v8v47n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 8))) (h p)+          (y9localToEnum fv8v46v8v47n p)+        where+        +        h p = T.con0 T.mkNoSrcPos p September aSeptember+        h p = y9localToEnum fv8v46v8v47n p+        +      y8localToEnum fv8v46v8v47n p = y9localToEnum fv8v46v8v47n p+      +      y9localToEnum fv8v46v8v47n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv8v46v8v47n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 9))) (h p)+          (y10localToEnum fv8v46v8v47n p)+        where+        +        h p = T.con0 T.mkNoSrcPos p October aOctober+        h p = y10localToEnum fv8v46v8v47n p+        +      y9localToEnum fv8v46v8v47n p = y10localToEnum fv8v46v8v47n p+      +      y10localToEnum fv8v46v8v47n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv8v46v8v47n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 10))) (h p)+          (y11localToEnum fv8v46v8v47n p)+        where+        +        h p = T.con0 T.mkNoSrcPos p November aNovember+        h p = y11localToEnum fv8v46v8v47n p+        +      y10localToEnum fv8v46v8v47n p = y11localToEnum fv8v46v8v47n p+      +      y11localToEnum fv8v46v8v47n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv8v46v8v47n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 11))) (h p) (T.fatal p)+        where+        +        h p = T.con0 T.mkNoSrcPos p December aDecember+        h p = T.fatal p+        +      y11localToEnum _ p = T.fatal p+      +      glocalFromEnum ::+        T.RefSrcPos -> T.RefExp -> T.R (T.Fun Month Hat.Prelude.Int)+      +      hlocalFromEnum :: (T.R Month) -> T.RefExp -> T.R Hat.Prelude.Int+      +      glocalFromEnum plocalFromEnum p =+        T.ufun1 a8v46v8v47localFromEnum plocalFromEnum p hlocalFromEnum+      +      alocalFromEnum = a8v46v8v47localFromEnum+      +      hlocalFromEnum (T.R January _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0)+      hlocalFromEnum (T.R February _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 1)+      hlocalFromEnum (T.R March _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 2)+      hlocalFromEnum (T.R April _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 3)+      hlocalFromEnum (T.R May _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 4)+      hlocalFromEnum (T.R June _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 5)+      hlocalFromEnum (T.R July _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 6)+      hlocalFromEnum (T.R August _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 7)+      hlocalFromEnum (T.R September _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 8)+      hlocalFromEnum (T.R October _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 9)+      hlocalFromEnum (T.R November _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 10)+      hlocalFromEnum (T.R December _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 11)+      hlocalFromEnum _ p = T.fatal p+      +    hrange _ p = T.fatal p+    +  +  gindex pindex p =+    T.ufun2 a8v46v8v47index pindex p hindex+    where+    +    hindex (T.R (T.Tuple2 fy1 fy2) _) fy3 p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!- p)+        (T.uwrapForward p (hlocalFromEnum fy3 p))+        (T.uwrapForward p (hlocalFromEnum fy1 p))+      where+      +      glocalFromEnum ::+        T.RefSrcPos -> T.RefExp -> T.R (T.Fun Month Hat.Prelude.Int)+      +      hlocalFromEnum :: (T.R Month) -> T.RefExp -> T.R Hat.Prelude.Int+      +      glocalFromEnum plocalFromEnum p =+        T.ufun1 a8v46v8v47localFromEnum plocalFromEnum p hlocalFromEnum+      +      alocalFromEnum = a8v46v8v47localFromEnum+      +      hlocalFromEnum (T.R January _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0)+      hlocalFromEnum (T.R February _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 1)+      hlocalFromEnum (T.R March _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 2)+      hlocalFromEnum (T.R April _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 3)+      hlocalFromEnum (T.R May _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 4)+      hlocalFromEnum (T.R June _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 5)+      hlocalFromEnum (T.R July _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 6)+      hlocalFromEnum (T.R August _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 7)+      hlocalFromEnum (T.R September _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 8)+      hlocalFromEnum (T.R October _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 9)+      hlocalFromEnum (T.R November _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 10)+      hlocalFromEnum (T.R December _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 11)+      hlocalFromEnum _ p = T.fatal p+      +    hindex _ _ p = T.fatal p+    +  +  ginRange pinRange p =+    T.ufun2 a8v46v8v47inRange pinRange p hinRange+    where+    +    hinRange (T.R (T.Tuple2 fy1 fy2) _) fy3 p =+      T.uap2 T.mkNoSrcPos p (Hat.Ix.ginRange T.mkNoSrcPos p)+        (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+          (T.uwrapForward p (hlocalFromEnum fy1 p))+          (T.uwrapForward p (hlocalFromEnum fy2 p)))+        (T.uwrapForward p (hlocalFromEnum fy3 p))+      where+      +      glocalFromEnum ::+        T.RefSrcPos -> T.RefExp -> T.R (T.Fun Month Hat.Prelude.Int)+      +      hlocalFromEnum :: (T.R Month) -> T.RefExp -> T.R Hat.Prelude.Int+      +      glocalFromEnum plocalFromEnum p =+        T.ufun1 a8v46v8v47localFromEnum plocalFromEnum p hlocalFromEnum+      +      alocalFromEnum = a8v46v8v47localFromEnum+      +      hlocalFromEnum (T.R January _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0)+      hlocalFromEnum (T.R February _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 1)+      hlocalFromEnum (T.R March _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 2)+      hlocalFromEnum (T.R April _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 3)+      hlocalFromEnum (T.R May _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 4)+      hlocalFromEnum (T.R June _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 5)+      hlocalFromEnum (T.R July _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 6)+      hlocalFromEnum (T.R August _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 7)+      hlocalFromEnum (T.R September _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 8)+      hlocalFromEnum (T.R October _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 9)+      hlocalFromEnum (T.R November _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 10)+      hlocalFromEnum (T.R December _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 11)+      hlocalFromEnum _ p = T.fatal p+      +    hinRange _ _ p = T.fatal p+    +  ++instance Read (Month)+  where+  +  greadsPrec preadsPrec p =+    T.ufun1 a8v50v8v53readsPrec preadsPrec p hreadsPrec+    where+    +    hreadsPrec fy1 p =+      T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.galt T.mkNoSrcPos p)+        (T.uwrapForward p+          (Hat.Prelude.hreadParen+            (T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse)+            (T.uwrapForward p+              (Hat.PreludeBasic.hthenLex+                (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                  (T.con0 T.mkNoSrcPos p January aJanuary))+                (T.fromLitString T.mkNoSrcPos p "January") p)) p))+        (T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.galt T.mkNoSrcPos p)+          (T.uwrapForward p+            (Hat.Prelude.hreadParen+              (T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse)+              (T.uwrapForward p+                (Hat.PreludeBasic.hthenLex+                  (T.uap1 T.mkNoSrcPos p+                    (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                    (T.con0 T.mkNoSrcPos p February aFebruary))+                  (T.fromLitString T.mkNoSrcPos p "February") p)) p))+          (T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.galt T.mkNoSrcPos p)+            (T.uwrapForward p+              (Hat.Prelude.hreadParen+                (T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse)+                (T.uwrapForward p+                  (Hat.PreludeBasic.hthenLex+                    (T.uap1 T.mkNoSrcPos p+                      (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                      (T.con0 T.mkNoSrcPos p March aMarch))+                    (T.fromLitString T.mkNoSrcPos p "March") p)) p))+            (T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.galt T.mkNoSrcPos p)+              (T.uwrapForward p+                (Hat.Prelude.hreadParen+                  (T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse)+                  (T.uwrapForward p+                    (Hat.PreludeBasic.hthenLex+                      (T.uap1 T.mkNoSrcPos p+                        (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                        (T.con0 T.mkNoSrcPos p April aApril))+                      (T.fromLitString T.mkNoSrcPos p "April") p)) p))+              (T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.galt T.mkNoSrcPos p)+                (T.uwrapForward p+                  (Hat.Prelude.hreadParen+                    (T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse)+                    (T.uwrapForward p+                      (Hat.PreludeBasic.hthenLex+                        (T.uap1 T.mkNoSrcPos p+                          (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                          (T.con0 T.mkNoSrcPos p May aMay))+                        (T.fromLitString T.mkNoSrcPos p "May") p)) p))+                (T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.galt T.mkNoSrcPos p)+                  (T.uwrapForward p+                    (Hat.Prelude.hreadParen+                      (T.con0 T.mkNoSrcPos p Hat.Prelude.False+                        Hat.Prelude.aFalse)+                      (T.uwrapForward p+                        (Hat.PreludeBasic.hthenLex+                          (T.uap1 T.mkNoSrcPos p+                            (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                            (T.con0 T.mkNoSrcPos p June aJune))+                          (T.fromLitString T.mkNoSrcPos p "June") p)) p))+                  (T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.galt T.mkNoSrcPos p)+                    (T.uwrapForward p+                      (Hat.Prelude.hreadParen+                        (T.con0 T.mkNoSrcPos p Hat.Prelude.False+                          Hat.Prelude.aFalse)+                        (T.uwrapForward p+                          (Hat.PreludeBasic.hthenLex+                            (T.uap1 T.mkNoSrcPos p+                              (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                              (T.con0 T.mkNoSrcPos p July aJuly))+                            (T.fromLitString T.mkNoSrcPos p "July") p)) p))+                    (T.uap2 T.mkNoSrcPos p+                      (Hat.PreludeBasic.galt T.mkNoSrcPos p)+                      (T.uwrapForward p+                        (Hat.Prelude.hreadParen+                          (T.con0 T.mkNoSrcPos p Hat.Prelude.False+                            Hat.Prelude.aFalse)+                          (T.uwrapForward p+                            (Hat.PreludeBasic.hthenLex+                              (T.uap1 T.mkNoSrcPos p+                                (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                                (T.con0 T.mkNoSrcPos p August aAugust))+                              (T.fromLitString T.mkNoSrcPos p "August") p)) p))+                      (T.uap2 T.mkNoSrcPos p+                        (Hat.PreludeBasic.galt T.mkNoSrcPos p)+                        (T.uwrapForward p+                          (Hat.Prelude.hreadParen+                            (T.con0 T.mkNoSrcPos p Hat.Prelude.False+                              Hat.Prelude.aFalse)+                            (T.uwrapForward p+                              (Hat.PreludeBasic.hthenLex+                                (T.uap1 T.mkNoSrcPos p+                                  (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                                  (T.con0 T.mkNoSrcPos p September aSeptember))+                                (T.fromLitString T.mkNoSrcPos p "September") p))+                            p))+                        (T.uap2 T.mkNoSrcPos p+                          (Hat.PreludeBasic.galt T.mkNoSrcPos p)+                          (T.uwrapForward p+                            (Hat.Prelude.hreadParen+                              (T.con0 T.mkNoSrcPos p Hat.Prelude.False+                                Hat.Prelude.aFalse)+                              (T.uwrapForward p+                                (Hat.PreludeBasic.hthenLex+                                  (T.uap1 T.mkNoSrcPos p+                                    (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                                    (T.con0 T.mkNoSrcPos p October aOctober))+                                  (T.fromLitString T.mkNoSrcPos p "October") p))+                              p))+                          (T.uap2 T.mkNoSrcPos p+                            (Hat.PreludeBasic.galt T.mkNoSrcPos p)+                            (T.uwrapForward p+                              (Hat.Prelude.hreadParen+                                (T.con0 T.mkNoSrcPos p Hat.Prelude.False+                                  Hat.Prelude.aFalse)+                                (T.uwrapForward p+                                  (Hat.PreludeBasic.hthenLex+                                    (T.uap1 T.mkNoSrcPos p+                                      (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                                      (T.con0 T.mkNoSrcPos p November+                                        aNovember))+                                    (T.fromLitString T.mkNoSrcPos p "November")+                                    p)) p))+                            (T.uwrapForward p+                              (Hat.Prelude.hreadParen+                                (T.con0 T.mkNoSrcPos p Hat.Prelude.False+                                  Hat.Prelude.aFalse)+                                (T.uwrapForward p+                                  (Hat.PreludeBasic.hthenLex+                                    (T.uap1 T.mkNoSrcPos p+                                      (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                                      (T.con0 T.mkNoSrcPos p December+                                        aDecember))+                                    (T.fromLitString T.mkNoSrcPos p "December")+                                    p)) p))))))))))))+    +  ++instance Show (Month)+  where+  +  gshowsPrec pshowsPrec p =+    T.ufun2 a8v56v8v59showsPrec pshowsPrec p hshowsPrec+    where+    +    hshowsPrec fy1 (T.R (January) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "January")+    hshowsPrec fy1 (T.R (February) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "February")+    hshowsPrec fy1 (T.R (March) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "March")+    hshowsPrec fy1 (T.R (April) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "April")+    hshowsPrec fy1 (T.R (May) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "May")+    hshowsPrec fy1 (T.R (June) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "June")+    hshowsPrec fy1 (T.R (July) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "July")+    hshowsPrec fy1 (T.R (August) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "August")+    hshowsPrec fy1 (T.R (September) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "September")+    hshowsPrec fy1 (T.R (October) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "October")+    hshowsPrec fy1 (T.R (November) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "November")+    hshowsPrec fy1 (T.R (December) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "December")+    hshowsPrec _ _ p = T.fatal p+    +  ++data Day =+  Sunday  | Monday  | Tuesday  | Wednesday  | Thursday  | Friday  | Saturday ++instance T.WrapVal (Day)+  where+  +  wrapVal pwrapVal (kwrapVal@Sunday) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aSunday)+  wrapVal pwrapVal (kwrapVal@Monday) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aMonday)+  wrapVal pwrapVal (kwrapVal@Tuesday) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aTuesday)+  wrapVal pwrapVal (kwrapVal@Wednesday) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aWednesday)+  wrapVal pwrapVal (kwrapVal@Thursday) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aThursday)+  wrapVal pwrapVal (kwrapVal@Friday) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aFriday)+  wrapVal pwrapVal (kwrapVal@Saturday) p =+    T.R kwrapVal (T.mkValueUse p pwrapVal aSaturday)+  ++instance Eq (Day)+  where+  +  (!==) (%==) p =+    T.ufun2 (+#$=$$=#$=$%==) (%==) p (*==)+    where+    +    (*==) (T.R Sunday _) (T.R Sunday _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R Monday _) (T.R Monday _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R Tuesday _) (T.R Tuesday _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R Wednesday _) (T.R Wednesday _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R Thursday _) (T.R Thursday _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R Friday _) (T.R Friday _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) (T.R Saturday _) (T.R Saturday _) p =+      T.con0 T.mkNoSrcPos p Hat.Prelude.True Hat.Prelude.aTrue+    (*==) _ _ p = T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse+    +  ++instance Ord (Day)+  where+  +  gcompare pcompare p =+    T.ufun2 a12v26v12v28compare pcompare p hcompare+    where+    +    hcompare fy1 fy2 p =+      T.uap2 T.mkNoSrcPos p (Hat.Prelude.gcompare T.mkNoSrcPos p)+        (T.uwrapForward p (hlocalFromEnum fy1 p) :: T.R Hat.Prelude.Int)+        (T.uwrapForward p (hlocalFromEnum fy2 p))+      where+      +      glocalFromEnum plocalFromEnum p =+        T.ufun1 a12v26v12v28localFromEnum plocalFromEnum p hlocalFromEnum+      +      alocalFromEnum = a12v26v12v28localFromEnum+      +      hlocalFromEnum (T.R (Sunday) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0)+      hlocalFromEnum (T.R (Monday) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 1)+      hlocalFromEnum (T.R (Tuesday) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 2)+      hlocalFromEnum (T.R (Wednesday) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 3)+      hlocalFromEnum (T.R (Thursday) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 4)+      hlocalFromEnum (T.R (Friday) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 5)+      hlocalFromEnum (T.R (Saturday) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 6)+      hlocalFromEnum _ p = T.fatal p+      +    +  ++instance Enum (Day)+  where+  +  gfromEnum pfromEnum p =+    T.ufun1 a12v31v12v34fromEnum pfromEnum p hfromEnum+    where+    +    hfromEnum (T.R Sunday _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 0)+    hfromEnum (T.R Monday _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 1)+    hfromEnum (T.R Tuesday _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 2)+    hfromEnum (T.R Wednesday _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 3)+    hfromEnum (T.R Thursday _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 4)+    hfromEnum (T.R Friday _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 5)+    hfromEnum (T.R Saturday _) p =+      T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+        (T.conInteger T.mkNoSrcPos p 6)+    hfromEnum _ p = T.fatal p+    +  +  gtoEnum ptoEnum p =+    T.ufun1 a12v31v12v34toEnum ptoEnum p htoEnum+    where+    +    htoEnum fv12v31v12v34n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv12v31v12v34n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 0))) (h p) (y1toEnum fv12v31v12v34n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p Sunday aSunday+      h p = y1toEnum fv12v31v12v34n p+      +    htoEnum fv12v31v12v34n p = y1toEnum fv12v31v12v34n p+    +    y1toEnum fv12v31v12v34n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv12v31v12v34n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 1))) (h p) (y2toEnum fv12v31v12v34n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p Monday aMonday+      h p = y2toEnum fv12v31v12v34n p+      +    y1toEnum fv12v31v12v34n p = y2toEnum fv12v31v12v34n p+    +    y2toEnum fv12v31v12v34n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv12v31v12v34n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 2))) (h p) (y3toEnum fv12v31v12v34n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p Tuesday aTuesday+      h p = y3toEnum fv12v31v12v34n p+      +    y2toEnum fv12v31v12v34n p = y3toEnum fv12v31v12v34n p+    +    y3toEnum fv12v31v12v34n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv12v31v12v34n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 3))) (h p) (y4toEnum fv12v31v12v34n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p Wednesday aWednesday+      h p = y4toEnum fv12v31v12v34n p+      +    y3toEnum fv12v31v12v34n p = y4toEnum fv12v31v12v34n p+    +    y4toEnum fv12v31v12v34n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv12v31v12v34n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 4))) (h p) (y5toEnum fv12v31v12v34n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p Thursday aThursday+      h p = y5toEnum fv12v31v12v34n p+      +    y4toEnum fv12v31v12v34n p = y5toEnum fv12v31v12v34n p+    +    y5toEnum fv12v31v12v34n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv12v31v12v34n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 5))) (h p) (y6toEnum fv12v31v12v34n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p Friday aFriday+      h p = y6toEnum fv12v31v12v34n p+      +    y5toEnum fv12v31v12v34n p = y6toEnum fv12v31v12v34n p+    +    y6toEnum fv12v31v12v34n p =+      T.ucguard+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv12v31v12v34n+          (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+            (T.conInteger T.mkNoSrcPos p 6))) (h p) (y7toEnum fv12v31v12v34n p)+      where+      +      h p = T.con0 T.mkNoSrcPos p Saturday aSaturday+      h p = y7toEnum fv12v31v12v34n p+      +    y6toEnum fv12v31v12v34n p = y7toEnum fv12v31v12v34n p+    +    y7toEnum _ p =+      T.uwrapForward p+        (Hat.Prelude.herror+          (T.fromLitString T.mkNoSrcPos p "toEnum: argument out of bounds") p)+    +  +  genumFrom penumFrom p =+    T.ufun1 a12v31v12v34enumFrom penumFrom p henumFrom+    where+    +    henumFrom fy1 p =+      T.uap2 T.mkNoSrcPos p (Hat.Prelude.genumFromTo T.mkNoSrcPos p) fy1+        (T.con0 T.mkNoSrcPos p Saturday aSaturday)+    +  +  genumFromThen penumFromThen p =+    T.ufun2 a12v31v12v34enumFromThen penumFromThen p henumFromThen+    where+    +    henumFromThen fy1 fy2 p =+      T.uap3 T.mkNoSrcPos p (Hat.Prelude.genumFromThenTo T.mkNoSrcPos p) fy1 fy2+        (T.ucif p+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!>= p)+            (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gfromEnum T.mkNoSrcPos p) fy1)+            (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gfromEnum T.mkNoSrcPos p) fy2))+          (T.con0 T.mkNoSrcPos p Saturday aSaturday)+          (T.con0 T.mkNoSrcPos p Sunday aSunday))+    +  ++instance Bounded (Day)+  where+  +  gminBound pminBound p = T.uconstUse pminBound p sminBound+  +  sminBound =+    T.uconstDef T.mkRoot a12v37v12v43minBound+      (\ p -> T.con0 T.mkNoSrcPos p Sunday aSunday)+  +  gmaxBound pmaxBound p = T.uconstUse pmaxBound p smaxBound+  +  smaxBound =+    T.uconstDef T.mkRoot a12v37v12v43maxBound+      (\ p -> T.con0 T.mkNoSrcPos p Saturday aSaturday)+  ++instance Ix (Day)+  where+  +  grange prange p =+    T.ufun1 a12v46v12v47range prange p hrange+    where+    +    hrange (T.R (T.Tuple2 fy1 fy2) _) p =+      T.uwrapForward p+        (Hat.PreludeBasic.hmap (glocalToEnum T.mkNoSrcPos p)+          (T.uap2 T.mkNoSrcPos p (Hat.Prelude.genumFromTo T.mkNoSrcPos p)+            (T.uwrapForward p (hlocalFromEnum fy1 p))+            (T.uwrapForward p (hlocalFromEnum fy2 p))) p)+      where+      +      glocalToEnum :: T.RefSrcPos -> T.RefExp -> T.R (T.Fun Hat.Prelude.Int Day)+      +      hlocalToEnum :: (T.R Hat.Prelude.Int) -> T.RefExp -> T.R Day+      +      glocalToEnum plocalToEnum p =+        T.ufun1 a12v46v12v47localToEnum plocalToEnum p hlocalToEnum+      +      alocalToEnum = a12v46v12v47localToEnum+      +      hlocalToEnum fv12v46v12v47n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv12v46v12v47n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 0))) (h p)+          (y1localToEnum fv12v46v12v47n p)+        where+        +        h p = T.con0 T.mkNoSrcPos p Sunday aSunday+        h p = y1localToEnum fv12v46v12v47n p+        +      hlocalToEnum fv12v46v12v47n p = y1localToEnum fv12v46v12v47n p+      +      y1localToEnum fv12v46v12v47n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv12v46v12v47n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 1))) (h p)+          (y2localToEnum fv12v46v12v47n p)+        where+        +        h p = T.con0 T.mkNoSrcPos p Monday aMonday+        h p = y2localToEnum fv12v46v12v47n p+        +      y1localToEnum fv12v46v12v47n p = y2localToEnum fv12v46v12v47n p+      +      y2localToEnum fv12v46v12v47n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv12v46v12v47n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 2))) (h p)+          (y3localToEnum fv12v46v12v47n p)+        where+        +        h p = T.con0 T.mkNoSrcPos p Tuesday aTuesday+        h p = y3localToEnum fv12v46v12v47n p+        +      y2localToEnum fv12v46v12v47n p = y3localToEnum fv12v46v12v47n p+      +      y3localToEnum fv12v46v12v47n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv12v46v12v47n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 3))) (h p)+          (y4localToEnum fv12v46v12v47n p)+        where+        +        h p = T.con0 T.mkNoSrcPos p Wednesday aWednesday+        h p = y4localToEnum fv12v46v12v47n p+        +      y3localToEnum fv12v46v12v47n p = y4localToEnum fv12v46v12v47n p+      +      y4localToEnum fv12v46v12v47n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv12v46v12v47n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 4))) (h p)+          (y5localToEnum fv12v46v12v47n p)+        where+        +        h p = T.con0 T.mkNoSrcPos p Thursday aThursday+        h p = y5localToEnum fv12v46v12v47n p+        +      y4localToEnum fv12v46v12v47n p = y5localToEnum fv12v46v12v47n p+      +      y5localToEnum fv12v46v12v47n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv12v46v12v47n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 5))) (h p)+          (y6localToEnum fv12v46v12v47n p)+        where+        +        h p = T.con0 T.mkNoSrcPos p Friday aFriday+        h p = y6localToEnum fv12v46v12v47n p+        +      y5localToEnum fv12v46v12v47n p = y6localToEnum fv12v46v12v47n p+      +      y6localToEnum fv12v46v12v47n p =+        T.ucguard+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fv12v46v12v47n+            (T.uap1 T.mkNoSrcPos p+              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+              (T.conInteger T.mkNoSrcPos p 6))) (h p) (T.fatal p)+        where+        +        h p = T.con0 T.mkNoSrcPos p Saturday aSaturday+        h p = T.fatal p+        +      y6localToEnum _ p = T.fatal p+      +      glocalFromEnum ::+        T.RefSrcPos -> T.RefExp -> T.R (T.Fun Day Hat.Prelude.Int)+      +      hlocalFromEnum :: (T.R Day) -> T.RefExp -> T.R Hat.Prelude.Int+      +      glocalFromEnum plocalFromEnum p =+        T.ufun1 a12v46v12v47localFromEnum plocalFromEnum p hlocalFromEnum+      +      alocalFromEnum = a12v46v12v47localFromEnum+      +      hlocalFromEnum (T.R Sunday _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0)+      hlocalFromEnum (T.R Monday _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 1)+      hlocalFromEnum (T.R Tuesday _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 2)+      hlocalFromEnum (T.R Wednesday _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 3)+      hlocalFromEnum (T.R Thursday _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 4)+      hlocalFromEnum (T.R Friday _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 5)+      hlocalFromEnum (T.R Saturday _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 6)+      hlocalFromEnum _ p = T.fatal p+      +    hrange _ p = T.fatal p+    +  +  gindex pindex p =+    T.ufun2 a12v46v12v47index pindex p hindex+    where+    +    hindex (T.R (T.Tuple2 fy1 fy2) _) fy3 p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!- p)+        (T.uwrapForward p (hlocalFromEnum fy3 p))+        (T.uwrapForward p (hlocalFromEnum fy1 p))+      where+      +      glocalFromEnum ::+        T.RefSrcPos -> T.RefExp -> T.R (T.Fun Day Hat.Prelude.Int)+      +      hlocalFromEnum :: (T.R Day) -> T.RefExp -> T.R Hat.Prelude.Int+      +      glocalFromEnum plocalFromEnum p =+        T.ufun1 a12v46v12v47localFromEnum plocalFromEnum p hlocalFromEnum+      +      alocalFromEnum = a12v46v12v47localFromEnum+      +      hlocalFromEnum (T.R Sunday _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0)+      hlocalFromEnum (T.R Monday _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 1)+      hlocalFromEnum (T.R Tuesday _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 2)+      hlocalFromEnum (T.R Wednesday _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 3)+      hlocalFromEnum (T.R Thursday _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 4)+      hlocalFromEnum (T.R Friday _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 5)+      hlocalFromEnum (T.R Saturday _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 6)+      hlocalFromEnum _ p = T.fatal p+      +    hindex _ _ p = T.fatal p+    +  +  ginRange pinRange p =+    T.ufun2 a12v46v12v47inRange pinRange p hinRange+    where+    +    hinRange (T.R (T.Tuple2 fy1 fy2) _) fy3 p =+      T.uap2 T.mkNoSrcPos p (Hat.Ix.ginRange T.mkNoSrcPos p)+        (T.con2 T.mkNoSrcPos p T.Tuple2 T.aTuple2+          (T.uwrapForward p (hlocalFromEnum fy1 p))+          (T.uwrapForward p (hlocalFromEnum fy2 p)))+        (T.uwrapForward p (hlocalFromEnum fy3 p))+      where+      +      glocalFromEnum ::+        T.RefSrcPos -> T.RefExp -> T.R (T.Fun Day Hat.Prelude.Int)+      +      hlocalFromEnum :: (T.R Day) -> T.RefExp -> T.R Hat.Prelude.Int+      +      glocalFromEnum plocalFromEnum p =+        T.ufun1 a12v46v12v47localFromEnum plocalFromEnum p hlocalFromEnum+      +      alocalFromEnum = a12v46v12v47localFromEnum+      +      hlocalFromEnum (T.R Sunday _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0)+      hlocalFromEnum (T.R Monday _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 1)+      hlocalFromEnum (T.R Tuesday _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 2)+      hlocalFromEnum (T.R Wednesday _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 3)+      hlocalFromEnum (T.R Thursday _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 4)+      hlocalFromEnum (T.R Friday _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 5)+      hlocalFromEnum (T.R Saturday _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 6)+      hlocalFromEnum _ p = T.fatal p+      +    hinRange _ _ p = T.fatal p+    +  ++instance Read (Day)+  where+  +  greadsPrec preadsPrec p =+    T.ufun1 a12v50v12v53readsPrec preadsPrec p hreadsPrec+    where+    +    hreadsPrec fy1 p =+      T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.galt T.mkNoSrcPos p)+        (T.uwrapForward p+          (Hat.Prelude.hreadParen+            (T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse)+            (T.uwrapForward p+              (Hat.PreludeBasic.hthenLex+                (T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                  (T.con0 T.mkNoSrcPos p Sunday aSunday))+                (T.fromLitString T.mkNoSrcPos p "Sunday") p)) p))+        (T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.galt T.mkNoSrcPos p)+          (T.uwrapForward p+            (Hat.Prelude.hreadParen+              (T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse)+              (T.uwrapForward p+                (Hat.PreludeBasic.hthenLex+                  (T.uap1 T.mkNoSrcPos p+                    (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                    (T.con0 T.mkNoSrcPos p Monday aMonday))+                  (T.fromLitString T.mkNoSrcPos p "Monday") p)) p))+          (T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.galt T.mkNoSrcPos p)+            (T.uwrapForward p+              (Hat.Prelude.hreadParen+                (T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse)+                (T.uwrapForward p+                  (Hat.PreludeBasic.hthenLex+                    (T.uap1 T.mkNoSrcPos p+                      (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                      (T.con0 T.mkNoSrcPos p Tuesday aTuesday))+                    (T.fromLitString T.mkNoSrcPos p "Tuesday") p)) p))+            (T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.galt T.mkNoSrcPos p)+              (T.uwrapForward p+                (Hat.Prelude.hreadParen+                  (T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse)+                  (T.uwrapForward p+                    (Hat.PreludeBasic.hthenLex+                      (T.uap1 T.mkNoSrcPos p+                        (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                        (T.con0 T.mkNoSrcPos p Wednesday aWednesday))+                      (T.fromLitString T.mkNoSrcPos p "Wednesday") p)) p))+              (T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.galt T.mkNoSrcPos p)+                (T.uwrapForward p+                  (Hat.Prelude.hreadParen+                    (T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse)+                    (T.uwrapForward p+                      (Hat.PreludeBasic.hthenLex+                        (T.uap1 T.mkNoSrcPos p+                          (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                          (T.con0 T.mkNoSrcPos p Thursday aThursday))+                        (T.fromLitString T.mkNoSrcPos p "Thursday") p)) p))+                (T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.galt T.mkNoSrcPos p)+                  (T.uwrapForward p+                    (Hat.Prelude.hreadParen+                      (T.con0 T.mkNoSrcPos p Hat.Prelude.False+                        Hat.Prelude.aFalse)+                      (T.uwrapForward p+                        (Hat.PreludeBasic.hthenLex+                          (T.uap1 T.mkNoSrcPos p+                            (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                            (T.con0 T.mkNoSrcPos p Friday aFriday))+                          (T.fromLitString T.mkNoSrcPos p "Friday") p)) p))+                  (T.uwrapForward p+                    (Hat.Prelude.hreadParen+                      (T.con0 T.mkNoSrcPos p Hat.Prelude.False+                        Hat.Prelude.aFalse)+                      (T.uwrapForward p+                        (Hat.PreludeBasic.hthenLex+                          (T.uap1 T.mkNoSrcPos p+                            (Hat.PreludeBasic.gyield T.mkNoSrcPos p)+                            (T.con0 T.mkNoSrcPos p Saturday aSaturday))+                          (T.fromLitString T.mkNoSrcPos p "Saturday") p))+                      p)))))))+    +  ++instance Show (Day)+  where+  +  gshowsPrec pshowsPrec p =+    T.ufun2 a12v56v12v59showsPrec pshowsPrec p hshowsPrec+    where+    +    hshowsPrec fy1 (T.R (Sunday) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "Sunday")+    hshowsPrec fy1 (T.R (Monday) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "Monday")+    hshowsPrec fy1 (T.R (Tuesday) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "Tuesday")+    hshowsPrec fy1 (T.R (Wednesday) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "Wednesday")+    hshowsPrec fy1 (T.R (Thursday) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "Thursday")+    hshowsPrec fy1 (T.R (Friday) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "Friday")+    hshowsPrec fy1 (T.R (Saturday) _) p =+      T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+        (T.fromLitString T.mkNoSrcPos p "Saturday")+    hshowsPrec _ _ p = T.fatal p+    +  ++data CalendarTime =+  CalendarTime+    {bctYear :: T.R Int,bctMonth :: T.R Month+      ,bctDay,bctHour,bctMin,bctSec :: T.R Int,bctPicosec :: T.R Integer+      ,bctWDay :: T.R Day,bctYDay :: T.R Int,bctTZName :: T.R String+      ,bctTZ :: T.R Int,bctIsDST :: T.R Bool}++instance T.WrapVal (CalendarTime)+  where+  +  wrapVal pwrapVal+    (kwrapVal@(CalendarTime (T.R _ z1wrapVal) (T.R _ z2wrapVal)+        (T.R _ z3wrapVal) (T.R _ z4wrapVal) (T.R _ z5wrapVal) (T.R _ z6wrapVal)+        (T.R _ z7wrapVal) (T.R _ z8wrapVal) (T.R _ z9wrapVal) (T.R _ z10wrapVal)+        (T.R _ z11wrapVal) (T.R _ z12wrapVal))) p =+    T.R kwrapVal+      (T.mkValueApp12 p pwrapVal aCalendarTime z1wrapVal z2wrapVal z3wrapVal+        z4wrapVal z5wrapVal z6wrapVal z7wrapVal z8wrapVal z9wrapVal z10wrapVal+        z11wrapVal z12wrapVal)+  ++gctYear pctYear p = T.ufun1 actYear pctYear p hctYear++hctYear (T.R z1ctYear _) p = T.projection T.mkNoSrcPos p (bctYear z1ctYear)++gctMonth pctMonth p = T.ufun1 actMonth pctMonth p hctMonth++hctMonth (T.R z1ctMonth _) p = T.projection T.mkNoSrcPos p (bctMonth z1ctMonth)++gctDay pctDay p = T.ufun1 actDay pctDay p hctDay++hctDay (T.R z1ctDay _) p = T.projection T.mkNoSrcPos p (bctDay z1ctDay)++gctHour pctHour p = T.ufun1 actHour pctHour p hctHour++hctHour (T.R z1ctHour _) p = T.projection T.mkNoSrcPos p (bctHour z1ctHour)++gctMin pctMin p = T.ufun1 actMin pctMin p hctMin++hctMin (T.R z1ctMin _) p = T.projection T.mkNoSrcPos p (bctMin z1ctMin)++gctSec pctSec p = T.ufun1 actSec pctSec p hctSec++hctSec (T.R z1ctSec _) p = T.projection T.mkNoSrcPos p (bctSec z1ctSec)++gctPicosec pctPicosec p = T.ufun1 actPicosec pctPicosec p hctPicosec++hctPicosec (T.R z1ctPicosec _) p =+  T.projection T.mkNoSrcPos p (bctPicosec z1ctPicosec)++gctWDay pctWDay p = T.ufun1 actWDay pctWDay p hctWDay++hctWDay (T.R z1ctWDay _) p = T.projection T.mkNoSrcPos p (bctWDay z1ctWDay)++gctYDay pctYDay p = T.ufun1 actYDay pctYDay p hctYDay++hctYDay (T.R z1ctYDay _) p = T.projection T.mkNoSrcPos p (bctYDay z1ctYDay)++gctTZName pctTZName p = T.ufun1 actTZName pctTZName p hctTZName++hctTZName (T.R z1ctTZName _) p =+  T.projection T.mkNoSrcPos p (bctTZName z1ctTZName)++gctTZ pctTZ p = T.ufun1 actTZ pctTZ p hctTZ++hctTZ (T.R z1ctTZ _) p = T.projection T.mkNoSrcPos p (bctTZ z1ctTZ)++gctIsDST pctIsDST p = T.ufun1 actIsDST pctIsDST p hctIsDST++hctIsDST (T.R z1ctIsDST _) p = T.projection T.mkNoSrcPos p (bctIsDST z1ctIsDST)++instance Eq (CalendarTime)+  where+  +  (!==) (%==) p =+    T.ufun2 (+$&=$#=$&=$$==) (%==) p (*==)+    where+    +    (*==)+      (T.R (CalendarTime fy1 fy2 fy3 fy4 fy5 fy6 fy7 fy8 fy9 fy10 fy11 fy12) _)+      (T.R+        (CalendarTime fy13 fy14 fy15 fy16 fy17 fy18 fy19 fy20 fy21 fy22 fy23+          fy24) _) p =+      T.uwrapForward p+        (((T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fy1 fy13)+            Hat.Prelude.*&&+            (T.uwrapForward p+              (((T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fy2+                    fy14)+                  Hat.Prelude.*&&+                  (T.uwrapForward p+                    (((T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p)+                          fy3 fy15)+                        Hat.Prelude.*&&+                        (T.uwrapForward p+                          (((T.uap2 T.mkNoSrcPos p+                                (T.mkNoSrcPos Hat.Prelude.!== p) fy4 fy16)+                              Hat.Prelude.*&&+                              (T.uwrapForward p+                                (((T.uap2 T.mkNoSrcPos p+                                      (T.mkNoSrcPos Hat.Prelude.!== p) fy5 fy17)+                                    Hat.Prelude.*&&+                                    (T.uwrapForward p+                                      (((T.uap2 T.mkNoSrcPos p+                                            (T.mkNoSrcPos Hat.Prelude.!== p) fy6+                                            fy18)+                                          Hat.Prelude.*&&+                                          (T.uwrapForward p+                                            (((T.uap2 T.mkNoSrcPos p+                                                  (T.mkNoSrcPos+                                                    Hat.Prelude.!==+                                                    p) fy7 fy19)+                                                Hat.Prelude.*&&+                                                (T.uwrapForward p+                                                  (((T.uap2 T.mkNoSrcPos p+                                                        (T.mkNoSrcPos+                                                          Hat.Prelude.!==+                                                          p) fy8 fy20)+                                                      Hat.Prelude.*&&+                                                      (T.uwrapForward p+                                                        (((T.uap2 T.mkNoSrcPos p+                                                              (T.mkNoSrcPos+                                                                Hat.Prelude.!==+                                                                p) fy9 fy21)+                                                            Hat.Prelude.*&&+                                                            (T.uwrapForward p+                                                              (((T.uap2+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (T.mkNoSrcPos+                                                                      Hat.Prelude.!==+                                                                      p) fy10+                                                                    fy22)+                                                                  Hat.Prelude.*&&+                                                                  (T.uwrapForward+                                                                    p+                                                                    (((T.uap2+                                                                          T.mkNoSrcPos+                                                                          p+                                                                          (T.mkNoSrcPos+                                                                            Hat.Prelude.!==+                                                                            p)+                                                                          fy11+                                                                          fy23)+                                                                        Hat.Prelude.*&&+                                                                        (T.uap2+                                                                          T.mkNoSrcPos+                                                                          p+                                                                          (T.mkNoSrcPos+                                                                            Hat.Prelude.!==+                                                                            p)+                                                                          fy12+                                                                          fy24))+                                                                      p))) p)))+                                                          p))) p))) p))) p)))+                                  p))) p))) p))) p))) p)+    (*==) _ _ p = T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse+    +  ++instance Ord (CalendarTime)+  where+  +  gcompare pcompare p =+    T.ufun2 a24v25v24v27compare pcompare p hcompare+    where+    +    hcompare+      (T.R (CalendarTime fy3 fy4 fy5 fy6 fy7 fy8 fy9 fy10 fy11 fy12 fy13 fy14)+        _)+      (T.R+        (CalendarTime fy15 fy16 fy17 fy18 fy19 fy20 fy21 fy22 fy23 fy24 fy25+          fy26) _) p =+      T.uccase T.mkNoSrcPos p+        (let+          v24v25v24v27v1 (T.R Hat.Prelude.EQ _) p =+            T.uccase T.mkNoSrcPos p+              (let+                v24v25v24v27v1 (T.R Hat.Prelude.EQ _) p =+                  T.uccase T.mkNoSrcPos p+                    (let+                      v24v25v24v27v1 (T.R Hat.Prelude.EQ _) p =+                        T.uccase T.mkNoSrcPos p+                          (let+                            v24v25v24v27v1 (T.R Hat.Prelude.EQ _) p =+                              T.uccase T.mkNoSrcPos p+                                (let+                                  v24v25v24v27v1 (T.R Hat.Prelude.EQ _) p =+                                    T.uccase T.mkNoSrcPos p+                                      (let+                                        v24v25v24v27v1 (T.R Hat.Prelude.EQ _)+                                          p =+                                          T.uccase T.mkNoSrcPos p+                                            (let+                                              v24v25v24v27v1+                                                (T.R Hat.Prelude.EQ _) p =+                                                T.uccase T.mkNoSrcPos p+                                                  (let+                                                    v24v25v24v27v1+                                                      (T.R Hat.Prelude.EQ _) p =+                                                      T.uccase T.mkNoSrcPos p+                                                        (let+                                                          v24v25v24v27v1+                                                            (T.R Hat.Prelude.EQ+                                                              _) p =+                                                            T.uccase+                                                              T.mkNoSrcPos p+                                                              (let+                                                                v24v25v24v27v1+                                                                  (T.R+                                                                    Hat.Prelude.EQ+                                                                    _) p =+                                                                  T.uccase+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (let+                                                                      v24v25v24v27v1+                                                                        (T.R+                                                                          Hat.Prelude.EQ+                                                                          _) p =+                                                                        T.uap2+                                                                          T.mkNoSrcPos+                                                                          p+                                                                          (Hat.Prelude.gcompare+                                                                            T.mkNoSrcPos+                                                                            p)+                                                                          fy14+                                                                          fy26+                                                                      v24v25v24v27v1+                                                                        fy1 p =+                                                                        T.projection+                                                                          T.mkNoSrcPos+                                                                          p fy1+                                                                      in+                                                                      (v24v25v24v27v1))+                                                                    (T.uap2+                                                                      T.mkNoSrcPos+                                                                      p+                                                                      (Hat.Prelude.gcompare+                                                                        T.mkNoSrcPos+                                                                        p) fy13+                                                                      fy25)+                                                                v24v25v24v27v1+                                                                  fy1 p =+                                                                  T.projection+                                                                    T.mkNoSrcPos+                                                                    p fy1 in+                                                                (v24v25v24v27v1))+                                                              (T.uap2+                                                                T.mkNoSrcPos p+                                                                (Hat.Prelude.gcompare+                                                                  T.mkNoSrcPos+                                                                  p) fy12 fy24)+                                                          v24v25v24v27v1 fy1 p =+                                                            T.projection+                                                              T.mkNoSrcPos p fy1+                                                          in (v24v25v24v27v1))+                                                        (T.uap2 T.mkNoSrcPos p+                                                          (Hat.Prelude.gcompare+                                                            T.mkNoSrcPos p) fy11+                                                          fy23)+                                                    v24v25v24v27v1 fy1 p =+                                                      T.projection T.mkNoSrcPos+                                                        p fy1 in+                                                    (v24v25v24v27v1))+                                                  (T.uap2 T.mkNoSrcPos p+                                                    (Hat.Prelude.gcompare+                                                      T.mkNoSrcPos p) fy10 fy22)+                                              v24v25v24v27v1 fy1 p =+                                                T.projection T.mkNoSrcPos p fy1+                                              in (v24v25v24v27v1))+                                            (T.uap2 T.mkNoSrcPos p+                                              (Hat.Prelude.gcompare T.mkNoSrcPos+                                                p) fy9 fy21)+                                        v24v25v24v27v1 fy1 p =+                                          T.projection T.mkNoSrcPos p fy1 in+                                        (v24v25v24v27v1))+                                      (T.uap2 T.mkNoSrcPos p+                                        (Hat.Prelude.gcompare T.mkNoSrcPos p)+                                        fy8 fy20)+                                  v24v25v24v27v1 fy1 p =+                                    T.projection T.mkNoSrcPos p fy1 in+                                  (v24v25v24v27v1))+                                (T.uap2 T.mkNoSrcPos p+                                  (Hat.Prelude.gcompare T.mkNoSrcPos p) fy7+                                  fy19)+                            v24v25v24v27v1 fy1 p =+                              T.projection T.mkNoSrcPos p fy1 in+                            (v24v25v24v27v1))+                          (T.uap2 T.mkNoSrcPos p+                            (Hat.Prelude.gcompare T.mkNoSrcPos p) fy6 fy18)+                      v24v25v24v27v1 fy1 p = T.projection T.mkNoSrcPos p fy1 in+                      (v24v25v24v27v1))+                    (T.uap2 T.mkNoSrcPos p (Hat.Prelude.gcompare T.mkNoSrcPos p)+                      fy5 fy17)+                v24v25v24v27v1 fy1 p = T.projection T.mkNoSrcPos p fy1 in+                (v24v25v24v27v1))+              (T.uap2 T.mkNoSrcPos p (Hat.Prelude.gcompare T.mkNoSrcPos p) fy4+                fy16)+          v24v25v24v27v1 fy1 p = T.projection T.mkNoSrcPos p fy1 in+          (v24v25v24v27v1))+        (T.uap2 T.mkNoSrcPos p (Hat.Prelude.gcompare T.mkNoSrcPos p) fy3 fy15)+    hcompare fy1 fy2 p =+      T.uap2 T.mkNoSrcPos p (Hat.Prelude.gcompare T.mkNoSrcPos p)+        (T.uwrapForward p (hlocalFromEnum fy1 p) :: T.R Hat.Prelude.Int)+        (T.uwrapForward p (hlocalFromEnum fy2 p))+      where+      +      glocalFromEnum plocalFromEnum p =+        T.ufun1 a24v25v24v27localFromEnum plocalFromEnum p hlocalFromEnum+      +      alocalFromEnum = a24v25v24v27localFromEnum+      +      hlocalFromEnum (T.R (CalendarTime _ _ _ _ _ _ _ _ _ _ _ _) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0)+      hlocalFromEnum _ p = T.fatal p+      +    +  ++instance Read (CalendarTime)+  where+  +  greadsPrec preadsPrec p =+    T.ufun1 a24v30v24v33readsPrec preadsPrec p hreadsPrec+    where+    +    hreadsPrec fy1 p =+      T.uwrapForward p+        (Hat.PreludeBasic.hthenLex+          (T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.gthenAp T.mkNoSrcPos p)+            (T.uwrapForward p+              (Hat.PreludeBasic.hthenLex+                (T.uwrapForward p+                  (Hat.PreludeBasic.hthenLex+                    (T.uwrapForward p+                      (Hat.PreludeBasic.hthenLex+                        (T.uap2 T.mkNoSrcPos p+                          (Hat.PreludeBasic.gthenAp T.mkNoSrcPos p)+                          (T.uwrapForward p+                            (Hat.PreludeBasic.hthenLex+                              (T.uwrapForward p+                                (Hat.PreludeBasic.hthenLex+                                  (T.uwrapForward p+                                    (Hat.PreludeBasic.hthenLex+                                      (T.uap2 T.mkNoSrcPos p+                                        (Hat.PreludeBasic.gthenAp T.mkNoSrcPos+                                          p)+                                        (T.uwrapForward p+                                          (Hat.PreludeBasic.hthenLex+                                            (T.uwrapForward p+                                              (Hat.PreludeBasic.hthenLex+                                                (T.uwrapForward p+                                                  (Hat.PreludeBasic.hthenLex+                                                    (T.uap2 T.mkNoSrcPos p+                                                      (Hat.PreludeBasic.gthenAp+                                                        T.mkNoSrcPos p)+                                                      (T.uwrapForward p+                                                        (Hat.PreludeBasic.hthenLex+                                                          (T.uwrapForward p+                                                            (Hat.PreludeBasic.hthenLex+                                                              (T.uwrapForward p+                                                                (Hat.PreludeBasic.hthenLex+                                                                  (T.uap2+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (Hat.PreludeBasic.gthenAp+                                                                      T.mkNoSrcPos+                                                                      p)+                                                                    (T.uwrapForward+                                                                      p+                                                                      (Hat.PreludeBasic.hthenLex+                                                                        (T.uwrapForward+                                                                          p+                                                                          (Hat.PreludeBasic.hthenLex+                                                                            (T.uwrapForward+                                                                              p+                                                                              (Hat.PreludeBasic.hthenLex+                                                                                (T.uap2+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  (Hat.PreludeBasic.gthenAp+                                                                                    T.mkNoSrcPos+                                                                                    p)+                                                                                  (T.uwrapForward+                                                                                    p+                                                                                    (Hat.PreludeBasic.hthenLex+                                                                                      (T.uwrapForward+                                                                                        p+                                                                                        (Hat.PreludeBasic.hthenLex+                                                                                          (T.uwrapForward+                                                                                            p+                                                                                            (Hat.PreludeBasic.hthenLex+                                                                                              (T.uap2+                                                                                                T.mkNoSrcPos+                                                                                                p+                                                                                                (Hat.PreludeBasic.gthenAp+                                                                                                  T.mkNoSrcPos+                                                                                                  p)+                                                                                                (T.uwrapForward+                                                                                                  p+                                                                                                  (Hat.PreludeBasic.hthenLex+                                                                                                    (T.uwrapForward+                                                                                                      p+                                                                                                      (Hat.PreludeBasic.hthenLex+                                                                                                        (T.uwrapForward+                                                                                                          p+                                                                                                          (Hat.PreludeBasic.hthenLex+                                                                                                            (T.uap2+                                                                                                              T.mkNoSrcPos+                                                                                                              p+                                                                                                              (Hat.PreludeBasic.gthenAp+                                                                                                                T.mkNoSrcPos+                                                                                                                p)+                                                                                                              (T.uwrapForward+                                                                                                                p+                                                                                                                (Hat.PreludeBasic.hthenLex+                                                                                                                  (T.uwrapForward+                                                                                                                    p+                                                                                                                    (Hat.PreludeBasic.hthenLex+                                                                                                                      (T.uwrapForward+                                                                                                                        p+                                                                                                                        (Hat.PreludeBasic.hthenLex+                                                                                                                          (T.uap2+                                                                                                                            T.mkNoSrcPos+                                                                                                                            p+                                                                                                                            (Hat.PreludeBasic.gthenAp+                                                                                                                              T.mkNoSrcPos+                                                                                                                              p)+                                                                                                                            (T.uwrapForward+                                                                                                                              p+                                                                                                                              (Hat.PreludeBasic.hthenLex+                                                                                                                                (T.uwrapForward+                                                                                                                                  p+                                                                                                                                  (Hat.PreludeBasic.hthenLex+                                                                                                                                    (T.uwrapForward+                                                                                                                                      p+                                                                                                                                      (Hat.PreludeBasic.hthenLex+                                                                                                                                        (T.uap2+                                                                                                                                          T.mkNoSrcPos+                                                                                                                                          p+                                                                                                                                          (Hat.PreludeBasic.gthenAp+                                                                                                                                            T.mkNoSrcPos+                                                                                                                                            p)+                                                                                                                                          (T.uwrapForward+                                                                                                                                            p+                                                                                                                                            (Hat.PreludeBasic.hthenLex+                                                                                                                                              (T.uwrapForward+                                                                                                                                                p+                                                                                                                                                (Hat.PreludeBasic.hthenLex+                                                                                                                                                  (T.uwrapForward+                                                                                                                                                    p+                                                                                                                                                    (Hat.PreludeBasic.hthenLex+                                                                                                                                                      (T.uap2+                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                        p+                                                                                                                                                        (Hat.PreludeBasic.gthenAp+                                                                                                                                                          T.mkNoSrcPos+                                                                                                                                                          p)+                                                                                                                                                        (T.uwrapForward+                                                                                                                                                          p+                                                                                                                                                          (Hat.PreludeBasic.hthenLex+                                                                                                                                                            (T.uwrapForward+                                                                                                                                                              p+                                                                                                                                                              (Hat.PreludeBasic.hthenLex+                                                                                                                                                                (T.uwrapForward+                                                                                                                                                                  p+                                                                                                                                                                  (Hat.PreludeBasic.hthenLex+                                                                                                                                                                    (T.uap2+                                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                                      p+                                                                                                                                                                      (Hat.PreludeBasic.gthenAp+                                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                                        p)+                                                                                                                                                                      (T.uwrapForward+                                                                                                                                                                        p+                                                                                                                                                                        (Hat.PreludeBasic.hthenLex+                                                                                                                                                                          (T.uwrapForward+                                                                                                                                                                            p+                                                                                                                                                                            (Hat.PreludeBasic.hthenLex+                                                                                                                                                                              (T.uwrapForward+                                                                                                                                                                                p+                                                                                                                                                                                (Hat.PreludeBasic.hthenLex+                                                                                                                                                                                  (T.uwrapForward+                                                                                                                                                                                    p+                                                                                                                                                                                    (Hat.PreludeBasic.hthenLex+                                                                                                                                                                                      (T.uap1+                                                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                                                        p+                                                                                                                                                                                        (Hat.PreludeBasic.gyield+                                                                                                                                                                                          T.mkNoSrcPos+                                                                                                                                                                                          p)+                                                                                                                                                                                        (T.pa0+                                                                                                                                                                                          CalendarTime+                                                                                                                                                                                          T.cn12+                                                                                                                                                                                          T.mkNoSrcPos+                                                                                                                                                                                          p+                                                                                                                                                                                          aCalendarTime))+                                                                                                                                                                                      (T.fromLitString+                                                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                                                        p+                                                                                                                                                                                        "CalendarTime")+                                                                                                                                                                                      p))+                                                                                                                                                                                  (T.fromLitString+                                                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                                                    p+                                                                                                                                                                                    "{")+                                                                                                                                                                                  p))+                                                                                                                                                                              (T.fromLitString+                                                                                                                                                                                T.mkNoSrcPos+                                                                                                                                                                                p+                                                                                                                                                                                "ctYear")+                                                                                                                                                                              p))+                                                                                                                                                                          (T.fromLitString+                                                                                                                                                                            T.mkNoSrcPos+                                                                                                                                                                            p+                                                                                                                                                                            "=")+                                                                                                                                                                          p))+                                                                                                                                                                      (T.uap1+                                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                                        p+                                                                                                                                                                        (Hat.Prelude.greadsPrec+                                                                                                                                                                          T.mkNoSrcPos+                                                                                                                                                                          p)+                                                                                                                                                                        (T.uap1+                                                                                                                                                                          T.mkNoSrcPos+                                                                                                                                                                          p+                                                                                                                                                                          (Hat.PreludeBasic.gfromInteger+                                                                                                                                                                            T.mkNoSrcPos+                                                                                                                                                                            p)+                                                                                                                                                                          (T.conInteger+                                                                                                                                                                            T.mkNoSrcPos+                                                                                                                                                                            p+                                                                                                                                                                            0))))+                                                                                                                                                                    (T.fromLitString+                                                                                                                                                                      T.mkNoSrcPos+                                                                                                                                                                      p+                                                                                                                                                                      ",")+                                                                                                                                                                    p))+                                                                                                                                                                (T.fromLitString+                                                                                                                                                                  T.mkNoSrcPos+                                                                                                                                                                  p+                                                                                                                                                                  "ctMonth")+                                                                                                                                                                p))+                                                                                                                                                            (T.fromLitString+                                                                                                                                                              T.mkNoSrcPos+                                                                                                                                                              p+                                                                                                                                                              "=")+                                                                                                                                                            p))+                                                                                                                                                        (T.uap1+                                                                                                                                                          T.mkNoSrcPos+                                                                                                                                                          p+                                                                                                                                                          (Hat.Prelude.greadsPrec+                                                                                                                                                            T.mkNoSrcPos+                                                                                                                                                            p)+                                                                                                                                                          (T.uap1+                                                                                                                                                            T.mkNoSrcPos+                                                                                                                                                            p+                                                                                                                                                            (Hat.PreludeBasic.gfromInteger+                                                                                                                                                              T.mkNoSrcPos+                                                                                                                                                              p)+                                                                                                                                                            (T.conInteger+                                                                                                                                                              T.mkNoSrcPos+                                                                                                                                                              p+                                                                                                                                                              0))))+                                                                                                                                                      (T.fromLitString+                                                                                                                                                        T.mkNoSrcPos+                                                                                                                                                        p+                                                                                                                                                        ",")+                                                                                                                                                      p))+                                                                                                                                                  (T.fromLitString+                                                                                                                                                    T.mkNoSrcPos+                                                                                                                                                    p+                                                                                                                                                    "ctDay")+                                                                                                                                                  p))+                                                                                                                                              (T.fromLitString+                                                                                                                                                T.mkNoSrcPos+                                                                                                                                                p+                                                                                                                                                "=")+                                                                                                                                              p))+                                                                                                                                          (T.uap1+                                                                                                                                            T.mkNoSrcPos+                                                                                                                                            p+                                                                                                                                            (Hat.Prelude.greadsPrec+                                                                                                                                              T.mkNoSrcPos+                                                                                                                                              p)+                                                                                                                                            (T.uap1+                                                                                                                                              T.mkNoSrcPos+                                                                                                                                              p+                                                                                                                                              (Hat.PreludeBasic.gfromInteger+                                                                                                                                                T.mkNoSrcPos+                                                                                                                                                p)+                                                                                                                                              (T.conInteger+                                                                                                                                                T.mkNoSrcPos+                                                                                                                                                p+                                                                                                                                                0))))+                                                                                                                                        (T.fromLitString+                                                                                                                                          T.mkNoSrcPos+                                                                                                                                          p+                                                                                                                                          ",")+                                                                                                                                        p))+                                                                                                                                    (T.fromLitString+                                                                                                                                      T.mkNoSrcPos+                                                                                                                                      p+                                                                                                                                      "ctHour")+                                                                                                                                    p))+                                                                                                                                (T.fromLitString+                                                                                                                                  T.mkNoSrcPos+                                                                                                                                  p+                                                                                                                                  "=")+                                                                                                                                p))+                                                                                                                            (T.uap1+                                                                                                                              T.mkNoSrcPos+                                                                                                                              p+                                                                                                                              (Hat.Prelude.greadsPrec+                                                                                                                                T.mkNoSrcPos+                                                                                                                                p)+                                                                                                                              (T.uap1+                                                                                                                                T.mkNoSrcPos+                                                                                                                                p+                                                                                                                                (Hat.PreludeBasic.gfromInteger+                                                                                                                                  T.mkNoSrcPos+                                                                                                                                  p)+                                                                                                                                (T.conInteger+                                                                                                                                  T.mkNoSrcPos+                                                                                                                                  p+                                                                                                                                  0))))+                                                                                                                          (T.fromLitString+                                                                                                                            T.mkNoSrcPos+                                                                                                                            p+                                                                                                                            ",")+                                                                                                                          p))+                                                                                                                      (T.fromLitString+                                                                                                                        T.mkNoSrcPos+                                                                                                                        p+                                                                                                                        "ctMin")+                                                                                                                      p))+                                                                                                                  (T.fromLitString+                                                                                                                    T.mkNoSrcPos+                                                                                                                    p+                                                                                                                    "=")+                                                                                                                  p))+                                                                                                              (T.uap1+                                                                                                                T.mkNoSrcPos+                                                                                                                p+                                                                                                                (Hat.Prelude.greadsPrec+                                                                                                                  T.mkNoSrcPos+                                                                                                                  p)+                                                                                                                (T.uap1+                                                                                                                  T.mkNoSrcPos+                                                                                                                  p+                                                                                                                  (Hat.PreludeBasic.gfromInteger+                                                                                                                    T.mkNoSrcPos+                                                                                                                    p)+                                                                                                                  (T.conInteger+                                                                                                                    T.mkNoSrcPos+                                                                                                                    p+                                                                                                                    0))))+                                                                                                            (T.fromLitString+                                                                                                              T.mkNoSrcPos+                                                                                                              p+                                                                                                              ",")+                                                                                                            p))+                                                                                                        (T.fromLitString+                                                                                                          T.mkNoSrcPos+                                                                                                          p+                                                                                                          "ctSec")+                                                                                                        p))+                                                                                                    (T.fromLitString+                                                                                                      T.mkNoSrcPos+                                                                                                      p+                                                                                                      "=")+                                                                                                    p))+                                                                                                (T.uap1+                                                                                                  T.mkNoSrcPos+                                                                                                  p+                                                                                                  (Hat.Prelude.greadsPrec+                                                                                                    T.mkNoSrcPos+                                                                                                    p)+                                                                                                  (T.uap1+                                                                                                    T.mkNoSrcPos+                                                                                                    p+                                                                                                    (Hat.PreludeBasic.gfromInteger+                                                                                                      T.mkNoSrcPos+                                                                                                      p)+                                                                                                    (T.conInteger+                                                                                                      T.mkNoSrcPos+                                                                                                      p+                                                                                                      0))))+                                                                                              (T.fromLitString+                                                                                                T.mkNoSrcPos+                                                                                                p+                                                                                                ",")+                                                                                              p))+                                                                                          (T.fromLitString+                                                                                            T.mkNoSrcPos+                                                                                            p+                                                                                            "ctPicosec")+                                                                                          p))+                                                                                      (T.fromLitString+                                                                                        T.mkNoSrcPos+                                                                                        p+                                                                                        "=")+                                                                                      p))+                                                                                  (T.uap1+                                                                                    T.mkNoSrcPos+                                                                                    p+                                                                                    (Hat.Prelude.greadsPrec+                                                                                      T.mkNoSrcPos+                                                                                      p)+                                                                                    (T.uap1+                                                                                      T.mkNoSrcPos+                                                                                      p+                                                                                      (Hat.PreludeBasic.gfromInteger+                                                                                        T.mkNoSrcPos+                                                                                        p)+                                                                                      (T.conInteger+                                                                                        T.mkNoSrcPos+                                                                                        p+                                                                                        0))))+                                                                                (T.fromLitString+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  ",")+                                                                                p))+                                                                            (T.fromLitString+                                                                              T.mkNoSrcPos+                                                                              p+                                                                              "ctWDay")+                                                                            p))+                                                                        (T.fromLitString+                                                                          T.mkNoSrcPos+                                                                          p "=")+                                                                        p))+                                                                    (T.uap1+                                                                      T.mkNoSrcPos+                                                                      p+                                                                      (Hat.Prelude.greadsPrec+                                                                        T.mkNoSrcPos+                                                                        p)+                                                                      (T.uap1+                                                                        T.mkNoSrcPos+                                                                        p+                                                                        (Hat.PreludeBasic.gfromInteger+                                                                          T.mkNoSrcPos+                                                                          p)+                                                                        (T.conInteger+                                                                          T.mkNoSrcPos+                                                                          p+                                                                          0))))+                                                                  (T.fromLitString+                                                                    T.mkNoSrcPos+                                                                    p ",") p))+                                                              (T.fromLitString+                                                                T.mkNoSrcPos p+                                                                "ctYDay") p))+                                                          (T.fromLitString+                                                            T.mkNoSrcPos p "=")+                                                          p))+                                                      (T.uap1 T.mkNoSrcPos p+                                                        (Hat.Prelude.greadsPrec+                                                          T.mkNoSrcPos p)+                                                        (T.uap1 T.mkNoSrcPos p+                                                          (Hat.PreludeBasic.gfromInteger+                                                            T.mkNoSrcPos p)+                                                          (T.conInteger+                                                            T.mkNoSrcPos p 0))))+                                                    (T.fromLitString+                                                      T.mkNoSrcPos p ",") p))+                                                (T.fromLitString T.mkNoSrcPos p+                                                  "ctTZName") p))+                                            (T.fromLitString T.mkNoSrcPos p "=")+                                            p))+                                        (T.uap1 T.mkNoSrcPos p+                                          (Hat.Prelude.greadsPrec T.mkNoSrcPos+                                            p)+                                          (T.uap1 T.mkNoSrcPos p+                                            (Hat.PreludeBasic.gfromInteger+                                              T.mkNoSrcPos p)+                                            (T.conInteger T.mkNoSrcPos p 0))))+                                      (T.fromLitString T.mkNoSrcPos p ",") p))+                                  (T.fromLitString T.mkNoSrcPos p "ctTZ") p))+                              (T.fromLitString T.mkNoSrcPos p "=") p))+                          (T.uap1 T.mkNoSrcPos p+                            (Hat.Prelude.greadsPrec T.mkNoSrcPos p)+                            (T.uap1 T.mkNoSrcPos p+                              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                              (T.conInteger T.mkNoSrcPos p 0))))+                        (T.fromLitString T.mkNoSrcPos p ",") p))+                    (T.fromLitString T.mkNoSrcPos p "ctIsDST") p))+                (T.fromLitString T.mkNoSrcPos p "=") p))+            (T.uap1 T.mkNoSrcPos p (Hat.Prelude.greadsPrec T.mkNoSrcPos p)+              (T.uap1 T.mkNoSrcPos p+                (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                (T.conInteger T.mkNoSrcPos p 0))))+          (T.fromLitString T.mkNoSrcPos p "}") p)+    +  ++instance Show (CalendarTime)+  where+  +  gshowsPrec pshowsPrec p =+    T.ufun2 a24v36v24v39showsPrec pshowsPrec p hshowsPrec+    where+    +    hshowsPrec fy1+      (T.R (CalendarTime fy2 fy3 fy4 fy5 fy6 fy7 fy8 fy9 fy10 fy11 fy12 fy13) _)+      p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+          (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+            (T.fromLitString T.mkNoSrcPos p "CalendarTime{"))+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                  (T.uap1 T.mkNoSrcPos p+                    (Hat.Prelude.gshowString T.mkNoSrcPos p)+                    (T.fromLitString T.mkNoSrcPos p "ctYear"))+                  (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                    (T.conChar T.mkNoSrcPos p '=')))+                (T.uap2 T.mkNoSrcPos p (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                  (T.uap1 T.mkNoSrcPos p+                    (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                    (T.conInteger T.mkNoSrcPos p 0)) fy2))+              (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                (T.conChar T.mkNoSrcPos p ',')))+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                    (T.uap1 T.mkNoSrcPos p+                      (Hat.Prelude.gshowString T.mkNoSrcPos p)+                      (T.fromLitString T.mkNoSrcPos p "ctMonth"))+                    (T.uap1 T.mkNoSrcPos p+                      (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                      (T.conChar T.mkNoSrcPos p '=')))+                  (T.uap2 T.mkNoSrcPos p (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                    (T.uap1 T.mkNoSrcPos p+                      (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                      (T.conInteger T.mkNoSrcPos p 0)) fy3))+                (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                  (T.conChar T.mkNoSrcPos p ',')))+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                      (T.uap1 T.mkNoSrcPos p+                        (Hat.Prelude.gshowString T.mkNoSrcPos p)+                        (T.fromLitString T.mkNoSrcPos p "ctDay"))+                      (T.uap1 T.mkNoSrcPos p+                        (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                        (T.conChar T.mkNoSrcPos p '=')))+                    (T.uap2 T.mkNoSrcPos p+                      (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                      (T.uap1 T.mkNoSrcPos p+                        (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                        (T.conInteger T.mkNoSrcPos p 0)) fy4))+                  (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                    (T.conChar T.mkNoSrcPos p ',')))+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                        (T.uap1 T.mkNoSrcPos p+                          (Hat.Prelude.gshowString T.mkNoSrcPos p)+                          (T.fromLitString T.mkNoSrcPos p "ctHour"))+                        (T.uap1 T.mkNoSrcPos p+                          (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                          (T.conChar T.mkNoSrcPos p '=')))+                      (T.uap2 T.mkNoSrcPos p+                        (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                        (T.uap1 T.mkNoSrcPos p+                          (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                          (T.conInteger T.mkNoSrcPos p 0)) fy5))+                    (T.uap1 T.mkNoSrcPos p+                      (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                      (T.conChar T.mkNoSrcPos p ',')))+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                          (T.uap1 T.mkNoSrcPos p+                            (Hat.Prelude.gshowString T.mkNoSrcPos p)+                            (T.fromLitString T.mkNoSrcPos p "ctMin"))+                          (T.uap1 T.mkNoSrcPos p+                            (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                            (T.conChar T.mkNoSrcPos p '=')))+                        (T.uap2 T.mkNoSrcPos p+                          (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                          (T.uap1 T.mkNoSrcPos p+                            (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                            (T.conInteger T.mkNoSrcPos p 0)) fy6))+                      (T.uap1 T.mkNoSrcPos p+                        (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                        (T.conChar T.mkNoSrcPos p ',')))+                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                            (T.uap1 T.mkNoSrcPos p+                              (Hat.Prelude.gshowString T.mkNoSrcPos p)+                              (T.fromLitString T.mkNoSrcPos p "ctSec"))+                            (T.uap1 T.mkNoSrcPos p+                              (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                              (T.conChar T.mkNoSrcPos p '=')))+                          (T.uap2 T.mkNoSrcPos p+                            (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                            (T.uap1 T.mkNoSrcPos p+                              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                              (T.conInteger T.mkNoSrcPos p 0)) fy7))+                        (T.uap1 T.mkNoSrcPos p+                          (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                          (T.conChar T.mkNoSrcPos p ',')))+                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                            (T.uap2 T.mkNoSrcPos p+                              (T.mkNoSrcPos Hat.Prelude.!. p)+                              (T.uap1 T.mkNoSrcPos p+                                (Hat.Prelude.gshowString T.mkNoSrcPos p)+                                (T.fromLitString T.mkNoSrcPos p "ctPicosec"))+                              (T.uap1 T.mkNoSrcPos p+                                (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                                (T.conChar T.mkNoSrcPos p '=')))+                            (T.uap2 T.mkNoSrcPos p+                              (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                              (T.uap1 T.mkNoSrcPos p+                                (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                                (T.conInteger T.mkNoSrcPos p 0)) fy8))+                          (T.uap1 T.mkNoSrcPos p+                            (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                            (T.conChar T.mkNoSrcPos p ',')))+                        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                            (T.uap2 T.mkNoSrcPos p+                              (T.mkNoSrcPos Hat.Prelude.!. p)+                              (T.uap2 T.mkNoSrcPos p+                                (T.mkNoSrcPos Hat.Prelude.!. p)+                                (T.uap1 T.mkNoSrcPos p+                                  (Hat.Prelude.gshowString T.mkNoSrcPos p)+                                  (T.fromLitString T.mkNoSrcPos p "ctWDay"))+                                (T.uap1 T.mkNoSrcPos p+                                  (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                                  (T.conChar T.mkNoSrcPos p '=')))+                              (T.uap2 T.mkNoSrcPos p+                                (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                                (T.uap1 T.mkNoSrcPos p+                                  (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                                  (T.conInteger T.mkNoSrcPos p 0)) fy9))+                            (T.uap1 T.mkNoSrcPos p+                              (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                              (T.conChar T.mkNoSrcPos p ',')))+                          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                            (T.uap2 T.mkNoSrcPos p+                              (T.mkNoSrcPos Hat.Prelude.!. p)+                              (T.uap2 T.mkNoSrcPos p+                                (T.mkNoSrcPos Hat.Prelude.!. p)+                                (T.uap2 T.mkNoSrcPos p+                                  (T.mkNoSrcPos Hat.Prelude.!. p)+                                  (T.uap1 T.mkNoSrcPos p+                                    (Hat.Prelude.gshowString T.mkNoSrcPos p)+                                    (T.fromLitString T.mkNoSrcPos p "ctYDay"))+                                  (T.uap1 T.mkNoSrcPos p+                                    (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                                    (T.conChar T.mkNoSrcPos p '=')))+                                (T.uap2 T.mkNoSrcPos p+                                  (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                                  (T.uap1 T.mkNoSrcPos p+                                    (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos+                                      p) (T.conInteger T.mkNoSrcPos p 0)) fy10))+                              (T.uap1 T.mkNoSrcPos p+                                (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                                (T.conChar T.mkNoSrcPos p ',')))+                            (T.uap2 T.mkNoSrcPos p+                              (T.mkNoSrcPos Hat.Prelude.!. p)+                              (T.uap2 T.mkNoSrcPos p+                                (T.mkNoSrcPos Hat.Prelude.!. p)+                                (T.uap2 T.mkNoSrcPos p+                                  (T.mkNoSrcPos Hat.Prelude.!. p)+                                  (T.uap2 T.mkNoSrcPos p+                                    (T.mkNoSrcPos Hat.Prelude.!. p)+                                    (T.uap1 T.mkNoSrcPos p+                                      (Hat.Prelude.gshowString T.mkNoSrcPos p)+                                      (T.fromLitString T.mkNoSrcPos p+                                        "ctTZName"))+                                    (T.uap1 T.mkNoSrcPos p+                                      (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                                      (T.conChar T.mkNoSrcPos p '=')))+                                  (T.uap2 T.mkNoSrcPos p+                                    (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                                    (T.uap1 T.mkNoSrcPos p+                                      (Hat.PreludeBasic.gfromInteger+                                        T.mkNoSrcPos p)+                                      (T.conInteger T.mkNoSrcPos p 0)) fy11))+                                (T.uap1 T.mkNoSrcPos p+                                  (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                                  (T.conChar T.mkNoSrcPos p ',')))+                              (T.uap2 T.mkNoSrcPos p+                                (T.mkNoSrcPos Hat.Prelude.!. p)+                                (T.uap2 T.mkNoSrcPos p+                                  (T.mkNoSrcPos Hat.Prelude.!. p)+                                  (T.uap2 T.mkNoSrcPos p+                                    (T.mkNoSrcPos Hat.Prelude.!. p)+                                    (T.uap2 T.mkNoSrcPos p+                                      (T.mkNoSrcPos Hat.Prelude.!. p)+                                      (T.uap1 T.mkNoSrcPos p+                                        (Hat.Prelude.gshowString T.mkNoSrcPos p)+                                        (T.fromLitString T.mkNoSrcPos p "ctTZ"))+                                      (T.uap1 T.mkNoSrcPos p+                                        (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                                        (T.conChar T.mkNoSrcPos p '=')))+                                    (T.uap2 T.mkNoSrcPos p+                                      (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                                      (T.uap1 T.mkNoSrcPos p+                                        (Hat.PreludeBasic.gfromInteger+                                          T.mkNoSrcPos p)+                                        (T.conInteger T.mkNoSrcPos p 0)) fy12))+                                  (T.uap1 T.mkNoSrcPos p+                                    (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                                    (T.conChar T.mkNoSrcPos p ',')))+                                (T.uap2 T.mkNoSrcPos p+                                  (T.mkNoSrcPos Hat.Prelude.!. p)+                                  (T.uap2 T.mkNoSrcPos p+                                    (T.mkNoSrcPos Hat.Prelude.!. p)+                                    (T.uap1 T.mkNoSrcPos p+                                      (Hat.Prelude.gshowString T.mkNoSrcPos p)+                                      (T.fromLitString T.mkNoSrcPos p+                                        "ctIsDST"))+                                    (T.uap1 T.mkNoSrcPos p+                                      (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                                      (T.conChar T.mkNoSrcPos p '=')))+                                  (T.uap2 T.mkNoSrcPos p+                                    (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                                    (T.uap1 T.mkNoSrcPos p+                                      (Hat.PreludeBasic.gfromInteger+                                        T.mkNoSrcPos p)+                                      (T.conInteger T.mkNoSrcPos p 0))+                                    fy13))))))))))))))+        (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowChar T.mkNoSrcPos p)+          (T.conChar T.mkNoSrcPos p '}'))+    hshowsPrec _ _ p = T.fatal p+    +  ++data TimeDiff =+  TimeDiff+    {btdYear,btdMonth,btdDay,btdHour,btdMin,btdSec :: T.R Int+      ,btdPicosec :: T.R Integer}++instance T.WrapVal (TimeDiff)+  where+  +  wrapVal pwrapVal+    (kwrapVal@(TimeDiff (T.R _ z1wrapVal) (T.R _ z2wrapVal) (T.R _ z3wrapVal)+        (T.R _ z4wrapVal) (T.R _ z5wrapVal) (T.R _ z6wrapVal)+        (T.R _ z7wrapVal))) p =+    T.R kwrapVal+      (T.mkValueApp7 p pwrapVal aTimeDiff z1wrapVal z2wrapVal z3wrapVal+        z4wrapVal z5wrapVal z6wrapVal z7wrapVal)+  ++gtdYear ptdYear p = T.ufun1 atdYear ptdYear p htdYear++htdYear (T.R z1tdYear _) p = T.projection T.mkNoSrcPos p (btdYear z1tdYear)++gtdMonth ptdMonth p = T.ufun1 atdMonth ptdMonth p htdMonth++htdMonth (T.R z1tdMonth _) p = T.projection T.mkNoSrcPos p (btdMonth z1tdMonth)++gtdDay ptdDay p = T.ufun1 atdDay ptdDay p htdDay++htdDay (T.R z1tdDay _) p = T.projection T.mkNoSrcPos p (btdDay z1tdDay)++gtdHour ptdHour p = T.ufun1 atdHour ptdHour p htdHour++htdHour (T.R z1tdHour _) p = T.projection T.mkNoSrcPos p (btdHour z1tdHour)++gtdMin ptdMin p = T.ufun1 atdMin ptdMin p htdMin++htdMin (T.R z1tdMin _) p = T.projection T.mkNoSrcPos p (btdMin z1tdMin)++gtdSec ptdSec p = T.ufun1 atdSec ptdSec p htdSec++htdSec (T.R z1tdSec _) p = T.projection T.mkNoSrcPos p (btdSec z1tdSec)++gtdPicosec ptdPicosec p = T.ufun1 atdPicosec ptdPicosec p htdPicosec++htdPicosec (T.R z1tdPicosec _) p =+  T.projection T.mkNoSrcPos p (btdPicosec z1tdPicosec)++instance Eq (TimeDiff)+  where+  +  (!==) (%==) p =+    T.ufun2 (+$>=$#=$>=$$==) (%==) p (*==)+    where+    +    (*==) (T.R (TimeDiff fy1 fy2 fy3 fy4 fy5 fy6 fy7) _)+      (T.R (TimeDiff fy8 fy9 fy10 fy11 fy12 fy13 fy14) _) p =+      T.uwrapForward p+        (((T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fy1 fy8)+            Hat.Prelude.*&&+            (T.uwrapForward p+              (((T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p) fy2 fy9)+                  Hat.Prelude.*&&+                  (T.uwrapForward p+                    (((T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!== p)+                          fy3 fy10)+                        Hat.Prelude.*&&+                        (T.uwrapForward p+                          (((T.uap2 T.mkNoSrcPos p+                                (T.mkNoSrcPos Hat.Prelude.!== p) fy4 fy11)+                              Hat.Prelude.*&&+                              (T.uwrapForward p+                                (((T.uap2 T.mkNoSrcPos p+                                      (T.mkNoSrcPos Hat.Prelude.!== p) fy5 fy12)+                                    Hat.Prelude.*&&+                                    (T.uwrapForward p+                                      (((T.uap2 T.mkNoSrcPos p+                                            (T.mkNoSrcPos Hat.Prelude.!== p) fy6+                                            fy13)+                                          Hat.Prelude.*&&+                                          (T.uap2 T.mkNoSrcPos p+                                            (T.mkNoSrcPos Hat.Prelude.!== p) fy7+                                            fy14)) p))) p))) p))) p))) p))) p)+    (*==) _ _ p = T.con0 T.mkNoSrcPos p Hat.Prelude.False Hat.Prelude.aFalse+    +  ++instance Ord (TimeDiff)+  where+  +  gcompare pcompare p =+    T.ufun2 a29v25v29v27compare pcompare p hcompare+    where+    +    hcompare (T.R (TimeDiff fy3 fy4 fy5 fy6 fy7 fy8 fy9) _)+      (T.R (TimeDiff fy10 fy11 fy12 fy13 fy14 fy15 fy16) _) p =+      T.uccase T.mkNoSrcPos p+        (let+          v29v25v29v27v1 (T.R Hat.Prelude.EQ _) p =+            T.uccase T.mkNoSrcPos p+              (let+                v29v25v29v27v1 (T.R Hat.Prelude.EQ _) p =+                  T.uccase T.mkNoSrcPos p+                    (let+                      v29v25v29v27v1 (T.R Hat.Prelude.EQ _) p =+                        T.uccase T.mkNoSrcPos p+                          (let+                            v29v25v29v27v1 (T.R Hat.Prelude.EQ _) p =+                              T.uccase T.mkNoSrcPos p+                                (let+                                  v29v25v29v27v1 (T.R Hat.Prelude.EQ _) p =+                                    T.uccase T.mkNoSrcPos p+                                      (let+                                        v29v25v29v27v1 (T.R Hat.Prelude.EQ _)+                                          p =+                                          T.uap2 T.mkNoSrcPos p+                                            (Hat.Prelude.gcompare T.mkNoSrcPos+                                              p) fy9 fy16+                                        v29v25v29v27v1 fy1 p =+                                          T.projection T.mkNoSrcPos p fy1 in+                                        (v29v25v29v27v1))+                                      (T.uap2 T.mkNoSrcPos p+                                        (Hat.Prelude.gcompare T.mkNoSrcPos p)+                                        fy8 fy15)+                                  v29v25v29v27v1 fy1 p =+                                    T.projection T.mkNoSrcPos p fy1 in+                                  (v29v25v29v27v1))+                                (T.uap2 T.mkNoSrcPos p+                                  (Hat.Prelude.gcompare T.mkNoSrcPos p) fy7+                                  fy14)+                            v29v25v29v27v1 fy1 p =+                              T.projection T.mkNoSrcPos p fy1 in+                            (v29v25v29v27v1))+                          (T.uap2 T.mkNoSrcPos p+                            (Hat.Prelude.gcompare T.mkNoSrcPos p) fy6 fy13)+                      v29v25v29v27v1 fy1 p = T.projection T.mkNoSrcPos p fy1 in+                      (v29v25v29v27v1))+                    (T.uap2 T.mkNoSrcPos p (Hat.Prelude.gcompare T.mkNoSrcPos p)+                      fy5 fy12)+                v29v25v29v27v1 fy1 p = T.projection T.mkNoSrcPos p fy1 in+                (v29v25v29v27v1))+              (T.uap2 T.mkNoSrcPos p (Hat.Prelude.gcompare T.mkNoSrcPos p) fy4+                fy11)+          v29v25v29v27v1 fy1 p = T.projection T.mkNoSrcPos p fy1 in+          (v29v25v29v27v1))+        (T.uap2 T.mkNoSrcPos p (Hat.Prelude.gcompare T.mkNoSrcPos p) fy3 fy10)+    hcompare fy1 fy2 p =+      T.uap2 T.mkNoSrcPos p (Hat.Prelude.gcompare T.mkNoSrcPos p)+        (T.uwrapForward p (hlocalFromEnum fy1 p) :: T.R Hat.Prelude.Int)+        (T.uwrapForward p (hlocalFromEnum fy2 p))+      where+      +      glocalFromEnum plocalFromEnum p =+        T.ufun1 a29v25v29v27localFromEnum plocalFromEnum p hlocalFromEnum+      +      alocalFromEnum = a29v25v29v27localFromEnum+      +      hlocalFromEnum (T.R (TimeDiff _ _ _ _ _ _ _) _) p =+        T.uap1 T.mkNoSrcPos p (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+          (T.conInteger T.mkNoSrcPos p 0)+      hlocalFromEnum _ p = T.fatal p+      +    +  ++instance Read (TimeDiff)+  where+  +  greadsPrec preadsPrec p =+    T.ufun1 a29v30v29v33readsPrec preadsPrec p hreadsPrec+    where+    +    hreadsPrec fy1 p =+      T.uwrapForward p+        (Hat.PreludeBasic.hthenLex+          (T.uap2 T.mkNoSrcPos p (Hat.PreludeBasic.gthenAp T.mkNoSrcPos p)+            (T.uwrapForward p+              (Hat.PreludeBasic.hthenLex+                (T.uwrapForward p+                  (Hat.PreludeBasic.hthenLex+                    (T.uwrapForward p+                      (Hat.PreludeBasic.hthenLex+                        (T.uap2 T.mkNoSrcPos p+                          (Hat.PreludeBasic.gthenAp T.mkNoSrcPos p)+                          (T.uwrapForward p+                            (Hat.PreludeBasic.hthenLex+                              (T.uwrapForward p+                                (Hat.PreludeBasic.hthenLex+                                  (T.uwrapForward p+                                    (Hat.PreludeBasic.hthenLex+                                      (T.uap2 T.mkNoSrcPos p+                                        (Hat.PreludeBasic.gthenAp T.mkNoSrcPos+                                          p)+                                        (T.uwrapForward p+                                          (Hat.PreludeBasic.hthenLex+                                            (T.uwrapForward p+                                              (Hat.PreludeBasic.hthenLex+                                                (T.uwrapForward p+                                                  (Hat.PreludeBasic.hthenLex+                                                    (T.uap2 T.mkNoSrcPos p+                                                      (Hat.PreludeBasic.gthenAp+                                                        T.mkNoSrcPos p)+                                                      (T.uwrapForward p+                                                        (Hat.PreludeBasic.hthenLex+                                                          (T.uwrapForward p+                                                            (Hat.PreludeBasic.hthenLex+                                                              (T.uwrapForward p+                                                                (Hat.PreludeBasic.hthenLex+                                                                  (T.uap2+                                                                    T.mkNoSrcPos+                                                                    p+                                                                    (Hat.PreludeBasic.gthenAp+                                                                      T.mkNoSrcPos+                                                                      p)+                                                                    (T.uwrapForward+                                                                      p+                                                                      (Hat.PreludeBasic.hthenLex+                                                                        (T.uwrapForward+                                                                          p+                                                                          (Hat.PreludeBasic.hthenLex+                                                                            (T.uwrapForward+                                                                              p+                                                                              (Hat.PreludeBasic.hthenLex+                                                                                (T.uap2+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  (Hat.PreludeBasic.gthenAp+                                                                                    T.mkNoSrcPos+                                                                                    p)+                                                                                  (T.uwrapForward+                                                                                    p+                                                                                    (Hat.PreludeBasic.hthenLex+                                                                                      (T.uwrapForward+                                                                                        p+                                                                                        (Hat.PreludeBasic.hthenLex+                                                                                          (T.uwrapForward+                                                                                            p+                                                                                            (Hat.PreludeBasic.hthenLex+                                                                                              (T.uap2+                                                                                                T.mkNoSrcPos+                                                                                                p+                                                                                                (Hat.PreludeBasic.gthenAp+                                                                                                  T.mkNoSrcPos+                                                                                                  p)+                                                                                                (T.uwrapForward+                                                                                                  p+                                                                                                  (Hat.PreludeBasic.hthenLex+                                                                                                    (T.uwrapForward+                                                                                                      p+                                                                                                      (Hat.PreludeBasic.hthenLex+                                                                                                        (T.uwrapForward+                                                                                                          p+                                                                                                          (Hat.PreludeBasic.hthenLex+                                                                                                            (T.uwrapForward+                                                                                                              p+                                                                                                              (Hat.PreludeBasic.hthenLex+                                                                                                                (T.uap1+                                                                                                                  T.mkNoSrcPos+                                                                                                                  p+                                                                                                                  (Hat.PreludeBasic.gyield+                                                                                                                    T.mkNoSrcPos+                                                                                                                    p)+                                                                                                                  (T.pa0+                                                                                                                    TimeDiff+                                                                                                                    T.cn7+                                                                                                                    T.mkNoSrcPos+                                                                                                                    p+                                                                                                                    aTimeDiff))+                                                                                                                (T.fromLitString+                                                                                                                  T.mkNoSrcPos+                                                                                                                  p+                                                                                                                  "TimeDiff")+                                                                                                                p))+                                                                                                            (T.fromLitString+                                                                                                              T.mkNoSrcPos+                                                                                                              p+                                                                                                              "{")+                                                                                                            p))+                                                                                                        (T.fromLitString+                                                                                                          T.mkNoSrcPos+                                                                                                          p+                                                                                                          "tdYear")+                                                                                                        p))+                                                                                                    (T.fromLitString+                                                                                                      T.mkNoSrcPos+                                                                                                      p+                                                                                                      "=")+                                                                                                    p))+                                                                                                (T.uap1+                                                                                                  T.mkNoSrcPos+                                                                                                  p+                                                                                                  (Hat.Prelude.greadsPrec+                                                                                                    T.mkNoSrcPos+                                                                                                    p)+                                                                                                  (T.uap1+                                                                                                    T.mkNoSrcPos+                                                                                                    p+                                                                                                    (Hat.PreludeBasic.gfromInteger+                                                                                                      T.mkNoSrcPos+                                                                                                      p)+                                                                                                    (T.conInteger+                                                                                                      T.mkNoSrcPos+                                                                                                      p+                                                                                                      0))))+                                                                                              (T.fromLitString+                                                                                                T.mkNoSrcPos+                                                                                                p+                                                                                                ",")+                                                                                              p))+                                                                                          (T.fromLitString+                                                                                            T.mkNoSrcPos+                                                                                            p+                                                                                            "tdMonth")+                                                                                          p))+                                                                                      (T.fromLitString+                                                                                        T.mkNoSrcPos+                                                                                        p+                                                                                        "=")+                                                                                      p))+                                                                                  (T.uap1+                                                                                    T.mkNoSrcPos+                                                                                    p+                                                                                    (Hat.Prelude.greadsPrec+                                                                                      T.mkNoSrcPos+                                                                                      p)+                                                                                    (T.uap1+                                                                                      T.mkNoSrcPos+                                                                                      p+                                                                                      (Hat.PreludeBasic.gfromInteger+                                                                                        T.mkNoSrcPos+                                                                                        p)+                                                                                      (T.conInteger+                                                                                        T.mkNoSrcPos+                                                                                        p+                                                                                        0))))+                                                                                (T.fromLitString+                                                                                  T.mkNoSrcPos+                                                                                  p+                                                                                  ",")+                                                                                p))+                                                                            (T.fromLitString+                                                                              T.mkNoSrcPos+                                                                              p+                                                                              "tdDay")+                                                                            p))+                                                                        (T.fromLitString+                                                                          T.mkNoSrcPos+                                                                          p "=")+                                                                        p))+                                                                    (T.uap1+                                                                      T.mkNoSrcPos+                                                                      p+                                                                      (Hat.Prelude.greadsPrec+                                                                        T.mkNoSrcPos+                                                                        p)+                                                                      (T.uap1+                                                                        T.mkNoSrcPos+                                                                        p+                                                                        (Hat.PreludeBasic.gfromInteger+                                                                          T.mkNoSrcPos+                                                                          p)+                                                                        (T.conInteger+                                                                          T.mkNoSrcPos+                                                                          p+                                                                          0))))+                                                                  (T.fromLitString+                                                                    T.mkNoSrcPos+                                                                    p ",") p))+                                                              (T.fromLitString+                                                                T.mkNoSrcPos p+                                                                "tdHour") p))+                                                          (T.fromLitString+                                                            T.mkNoSrcPos p "=")+                                                          p))+                                                      (T.uap1 T.mkNoSrcPos p+                                                        (Hat.Prelude.greadsPrec+                                                          T.mkNoSrcPos p)+                                                        (T.uap1 T.mkNoSrcPos p+                                                          (Hat.PreludeBasic.gfromInteger+                                                            T.mkNoSrcPos p)+                                                          (T.conInteger+                                                            T.mkNoSrcPos p 0))))+                                                    (T.fromLitString+                                                      T.mkNoSrcPos p ",") p))+                                                (T.fromLitString T.mkNoSrcPos p+                                                  "tdMin") p))+                                            (T.fromLitString T.mkNoSrcPos p "=")+                                            p))+                                        (T.uap1 T.mkNoSrcPos p+                                          (Hat.Prelude.greadsPrec T.mkNoSrcPos+                                            p)+                                          (T.uap1 T.mkNoSrcPos p+                                            (Hat.PreludeBasic.gfromInteger+                                              T.mkNoSrcPos p)+                                            (T.conInteger T.mkNoSrcPos p 0))))+                                      (T.fromLitString T.mkNoSrcPos p ",") p))+                                  (T.fromLitString T.mkNoSrcPos p "tdSec") p))+                              (T.fromLitString T.mkNoSrcPos p "=") p))+                          (T.uap1 T.mkNoSrcPos p+                            (Hat.Prelude.greadsPrec T.mkNoSrcPos p)+                            (T.uap1 T.mkNoSrcPos p+                              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                              (T.conInteger T.mkNoSrcPos p 0))))+                        (T.fromLitString T.mkNoSrcPos p ",") p))+                    (T.fromLitString T.mkNoSrcPos p "tdPicosec") p))+                (T.fromLitString T.mkNoSrcPos p "=") p))+            (T.uap1 T.mkNoSrcPos p (Hat.Prelude.greadsPrec T.mkNoSrcPos p)+              (T.uap1 T.mkNoSrcPos p+                (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                (T.conInteger T.mkNoSrcPos p 0))))+          (T.fromLitString T.mkNoSrcPos p "}") p)+    +  ++instance Show (TimeDiff)+  where+  +  gshowsPrec pshowsPrec p =+    T.ufun2 a29v36v29v39showsPrec pshowsPrec p hshowsPrec+    where+    +    hshowsPrec fy1 (T.R (TimeDiff fy2 fy3 fy4 fy5 fy6 fy7 fy8) _) p =+      T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+          (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowString T.mkNoSrcPos p)+            (T.fromLitString T.mkNoSrcPos p "TimeDiff{"))+          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                  (T.uap1 T.mkNoSrcPos p+                    (Hat.Prelude.gshowString T.mkNoSrcPos p)+                    (T.fromLitString T.mkNoSrcPos p "tdYear"))+                  (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                    (T.conChar T.mkNoSrcPos p '=')))+                (T.uap2 T.mkNoSrcPos p (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                  (T.uap1 T.mkNoSrcPos p+                    (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                    (T.conInteger T.mkNoSrcPos p 0)) fy2))+              (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                (T.conChar T.mkNoSrcPos p ',')))+            (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                    (T.uap1 T.mkNoSrcPos p+                      (Hat.Prelude.gshowString T.mkNoSrcPos p)+                      (T.fromLitString T.mkNoSrcPos p "tdMonth"))+                    (T.uap1 T.mkNoSrcPos p+                      (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                      (T.conChar T.mkNoSrcPos p '=')))+                  (T.uap2 T.mkNoSrcPos p (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                    (T.uap1 T.mkNoSrcPos p+                      (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                      (T.conInteger T.mkNoSrcPos p 0)) fy3))+                (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                  (T.conChar T.mkNoSrcPos p ',')))+              (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                      (T.uap1 T.mkNoSrcPos p+                        (Hat.Prelude.gshowString T.mkNoSrcPos p)+                        (T.fromLitString T.mkNoSrcPos p "tdDay"))+                      (T.uap1 T.mkNoSrcPos p+                        (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                        (T.conChar T.mkNoSrcPos p '=')))+                    (T.uap2 T.mkNoSrcPos p+                      (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                      (T.uap1 T.mkNoSrcPos p+                        (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                        (T.conInteger T.mkNoSrcPos p 0)) fy4))+                  (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                    (T.conChar T.mkNoSrcPos p ',')))+                (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                        (T.uap1 T.mkNoSrcPos p+                          (Hat.Prelude.gshowString T.mkNoSrcPos p)+                          (T.fromLitString T.mkNoSrcPos p "tdHour"))+                        (T.uap1 T.mkNoSrcPos p+                          (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                          (T.conChar T.mkNoSrcPos p '=')))+                      (T.uap2 T.mkNoSrcPos p+                        (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                        (T.uap1 T.mkNoSrcPos p+                          (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                          (T.conInteger T.mkNoSrcPos p 0)) fy5))+                    (T.uap1 T.mkNoSrcPos p+                      (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                      (T.conChar T.mkNoSrcPos p ',')))+                  (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                          (T.uap1 T.mkNoSrcPos p+                            (Hat.Prelude.gshowString T.mkNoSrcPos p)+                            (T.fromLitString T.mkNoSrcPos p "tdMin"))+                          (T.uap1 T.mkNoSrcPos p+                            (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                            (T.conChar T.mkNoSrcPos p '=')))+                        (T.uap2 T.mkNoSrcPos p+                          (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                          (T.uap1 T.mkNoSrcPos p+                            (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                            (T.conInteger T.mkNoSrcPos p 0)) fy6))+                      (T.uap1 T.mkNoSrcPos p+                        (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                        (T.conChar T.mkNoSrcPos p ',')))+                    (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                          (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                            (T.uap1 T.mkNoSrcPos p+                              (Hat.Prelude.gshowString T.mkNoSrcPos p)+                              (T.fromLitString T.mkNoSrcPos p "tdSec"))+                            (T.uap1 T.mkNoSrcPos p+                              (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                              (T.conChar T.mkNoSrcPos p '=')))+                          (T.uap2 T.mkNoSrcPos p+                            (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                            (T.uap1 T.mkNoSrcPos p+                              (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                              (T.conInteger T.mkNoSrcPos p 0)) fy7))+                        (T.uap1 T.mkNoSrcPos p+                          (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                          (T.conChar T.mkNoSrcPos p ',')))+                      (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                        (T.uap2 T.mkNoSrcPos p (T.mkNoSrcPos Hat.Prelude.!. p)+                          (T.uap1 T.mkNoSrcPos p+                            (Hat.Prelude.gshowString T.mkNoSrcPos p)+                            (T.fromLitString T.mkNoSrcPos p "tdPicosec"))+                          (T.uap1 T.mkNoSrcPos p+                            (Hat.Prelude.gshowChar T.mkNoSrcPos p)+                            (T.conChar T.mkNoSrcPos p '=')))+                        (T.uap2 T.mkNoSrcPos p+                          (Hat.Prelude.gshowsPrec T.mkNoSrcPos p)+                          (T.uap1 T.mkNoSrcPos p+                            (Hat.PreludeBasic.gfromInteger T.mkNoSrcPos p)+                            (T.conInteger T.mkNoSrcPos p 0)) fy8)))))))))+        (T.uap1 T.mkNoSrcPos p (Hat.Prelude.gshowChar T.mkNoSrcPos p)+          (T.conChar T.mkNoSrcPos p '}'))+    hshowsPrec _ _ p = T.fatal p+    +  ++tTimeBuiltinTypes =+  T.mkModule "TimeBuiltinTypes" "TimeBuiltinTypes.hs" Prelude.False++aJanuary = T.mkConstructor tTimeBuiltinTypes 50015 50021 3 0 "January"++aFebruary = T.mkConstructor tTimeBuiltinTypes 50027 50034 3 0 "February"++aMarch = T.mkConstructor tTimeBuiltinTypes 50038 50042 3 0 "March"++aApril = T.mkConstructor tTimeBuiltinTypes 50049 50053 3 0 "April"++aMay = T.mkConstructor tTimeBuiltinTypes 60015 60017 3 0 "May"++aJune = T.mkConstructor tTimeBuiltinTypes 60027 60030 3 0 "June"++aJuly = T.mkConstructor tTimeBuiltinTypes 60038 60041 3 0 "July"++aAugust = T.mkConstructor tTimeBuiltinTypes 60049 60054 3 0 "August"++aSeptember = T.mkConstructor tTimeBuiltinTypes 70015 70023 3 0 "September"++aOctober = T.mkConstructor tTimeBuiltinTypes 70027 70033 3 0 "October"++aNovember = T.mkConstructor tTimeBuiltinTypes 70038 70045 3 0 "November"++aDecember = T.mkConstructor tTimeBuiltinTypes 70049 70056 3 0 "December"++aSunday = T.mkConstructor tTimeBuiltinTypes 100015 100020 3 0 "Sunday"++aMonday = T.mkConstructor tTimeBuiltinTypes 100024 100029 3 0 "Monday"++aTuesday = T.mkConstructor tTimeBuiltinTypes 100034 100040 3 0 "Tuesday"++aWednesday = T.mkConstructor tTimeBuiltinTypes 100045 100053 3 0 "Wednesday"++aThursday = T.mkConstructor tTimeBuiltinTypes 100057 100064 3 0 "Thursday"++aFriday = T.mkConstructor tTimeBuiltinTypes 110015 110020 3 0 "Friday"++aSaturday = T.mkConstructor tTimeBuiltinTypes 110024 110031 3 0 "Saturday"++aCalendarTime =+  T.mkConstructorWFields tTimeBuiltinTypes 140021 140032 3 12 "CalendarTime"+    (actYear+      :+      (actMonth+        :+        (actDay+          :+          (actHour+            :+            (actMin+              :+              (actSec+                :+                (actPicosec+                  :+                  (actWDay+                    :+                    (actYDay : (actTZName : (actTZ : (actIsDST : []))))))))))))++aTimeDiff =+  T.mkConstructorWFields tTimeBuiltinTypes 260017 260024 3 7 "TimeDiff"+    (atdYear+      :+      (atdMonth+        :+        (atdDay : (atdHour : (atdMin : (atdSec : (atdPicosec : [])))))))++actYear =+  T.mkVariable tTimeBuiltinTypes 150017 150022 3 1 "ctYear" Prelude.False++actMonth =+  T.mkVariable tTimeBuiltinTypes 160017 160023 3 1 "ctMonth" Prelude.False++actDay = T.mkVariable tTimeBuiltinTypes 170017 170021 3 1 "ctDay" Prelude.False++actHour =+  T.mkVariable tTimeBuiltinTypes 170024 170029 3 1 "ctHour" Prelude.False++actMin = T.mkVariable tTimeBuiltinTypes 170032 170036 3 1 "ctMin" Prelude.False++actSec = T.mkVariable tTimeBuiltinTypes 170039 170043 3 1 "ctSec" Prelude.False++actPicosec =+  T.mkVariable tTimeBuiltinTypes 180017 180025 3 1 "ctPicosec" Prelude.False++actWDay =+  T.mkVariable tTimeBuiltinTypes 190017 190022 3 1 "ctWDay" Prelude.False++actYDay =+  T.mkVariable tTimeBuiltinTypes 200017 200022 3 1 "ctYDay" Prelude.False++actTZName =+  T.mkVariable tTimeBuiltinTypes 210017 210024 3 1 "ctTZName" Prelude.False++actTZ = T.mkVariable tTimeBuiltinTypes 220017 220020 3 1 "ctTZ" Prelude.False++actIsDST =+  T.mkVariable tTimeBuiltinTypes 230017 230023 3 1 "ctIsDST" Prelude.False++atdYear =+  T.mkVariable tTimeBuiltinTypes 270017 270022 3 1 "tdYear" Prelude.False++atdMonth =+  T.mkVariable tTimeBuiltinTypes 270025 270031 3 1 "tdMonth" Prelude.False++atdDay = T.mkVariable tTimeBuiltinTypes 270034 270038 3 1 "tdDay" Prelude.False++atdHour =+  T.mkVariable tTimeBuiltinTypes 270041 270046 3 1 "tdHour" Prelude.False++atdMin = T.mkVariable tTimeBuiltinTypes 270049 270053 3 1 "tdMin" Prelude.False++atdSec = T.mkVariable tTimeBuiltinTypes 270056 270060 3 1 "tdSec" Prelude.False++atdPicosec =+  T.mkVariable tTimeBuiltinTypes 280017 280025 3 1 "tdPicosec" Prelude.False++(+@=$$=@=$%==) =+  T.mkVariable tTimeBuiltinTypes 80022 80023 3 2 "==" Prelude.False++a8v26v8v28compare =+  T.mkVariable tTimeBuiltinTypes 80026 80028 3 2 "compare" Prelude.False++a8v31v8v34fromEnum =+  T.mkVariable tTimeBuiltinTypes 80031 80034 3 1 "fromEnum" Prelude.False++a8v31v8v34toEnum =+  T.mkVariable tTimeBuiltinTypes 80031 80034 3 1 "toEnum" Prelude.False++a8v31v8v34enumFrom =+  T.mkVariable tTimeBuiltinTypes 80031 80034 3 1 "enumFrom" Prelude.False++a8v31v8v34enumFromThen =+  T.mkVariable tTimeBuiltinTypes 80031 80034 3 2 "enumFromThen" Prelude.False++a8v37v8v43minBound =+  T.mkVariable tTimeBuiltinTypes 80037 80043 3 0 "minBound" Prelude.False++a8v37v8v43maxBound =+  T.mkVariable tTimeBuiltinTypes 80037 80043 3 0 "maxBound" Prelude.False++a8v46v8v47range =+  T.mkVariable tTimeBuiltinTypes 80046 80047 3 1 "range" Prelude.False++a8v46v8v47index =+  T.mkVariable tTimeBuiltinTypes 80046 80047 3 2 "index" Prelude.False++a8v46v8v47inRange =+  T.mkVariable tTimeBuiltinTypes 80046 80047 3 2 "inRange" Prelude.False++a8v50v8v53readsPrec =+  T.mkVariable tTimeBuiltinTypes 80050 80053 3 1 "readsPrec" Prelude.False++a8v56v8v59showsPrec =+  T.mkVariable tTimeBuiltinTypes 80056 80059 3 2 "showsPrec" Prelude.False++(+#$=$$=#$=$%==) =+  T.mkVariable tTimeBuiltinTypes 120022 120023 3 2 "==" Prelude.False++a12v26v12v28compare =+  T.mkVariable tTimeBuiltinTypes 120026 120028 3 2 "compare" Prelude.False++a12v31v12v34fromEnum =+  T.mkVariable tTimeBuiltinTypes 120031 120034 3 1 "fromEnum" Prelude.False++a12v31v12v34toEnum =+  T.mkVariable tTimeBuiltinTypes 120031 120034 3 1 "toEnum" Prelude.False++a12v31v12v34enumFrom =+  T.mkVariable tTimeBuiltinTypes 120031 120034 3 1 "enumFrom" Prelude.False++a12v31v12v34enumFromThen =+  T.mkVariable tTimeBuiltinTypes 120031 120034 3 2 "enumFromThen" Prelude.False++a12v37v12v43minBound =+  T.mkVariable tTimeBuiltinTypes 120037 120043 3 0 "minBound" Prelude.False++a12v37v12v43maxBound =+  T.mkVariable tTimeBuiltinTypes 120037 120043 3 0 "maxBound" Prelude.False++a12v46v12v47range =+  T.mkVariable tTimeBuiltinTypes 120046 120047 3 1 "range" Prelude.False++a12v46v12v47index =+  T.mkVariable tTimeBuiltinTypes 120046 120047 3 2 "index" Prelude.False++a12v46v12v47inRange =+  T.mkVariable tTimeBuiltinTypes 120046 120047 3 2 "inRange" Prelude.False++a12v50v12v53readsPrec =+  T.mkVariable tTimeBuiltinTypes 120050 120053 3 1 "readsPrec" Prelude.False++a12v56v12v59showsPrec =+  T.mkVariable tTimeBuiltinTypes 120056 120059 3 2 "showsPrec" Prelude.False++(+$&=$#=$&=$$==) =+  T.mkVariable tTimeBuiltinTypes 240021 240022 3 2 "==" Prelude.False++a24v25v24v27compare =+  T.mkVariable tTimeBuiltinTypes 240025 240027 3 2 "compare" Prelude.False++a24v30v24v33readsPrec =+  T.mkVariable tTimeBuiltinTypes 240030 240033 3 1 "readsPrec" Prelude.False++a24v36v24v39showsPrec =+  T.mkVariable tTimeBuiltinTypes 240036 240039 3 2 "showsPrec" Prelude.False++(+$>=$#=$>=$$==) =+  T.mkVariable tTimeBuiltinTypes 290021 290022 3 2 "==" Prelude.False++a29v25v29v27compare =+  T.mkVariable tTimeBuiltinTypes 290025 290027 3 2 "compare" Prelude.False++a29v30v29v33readsPrec =+  T.mkVariable tTimeBuiltinTypes 290030 290033 3 1 "readsPrec" Prelude.False++a29v36v29v39showsPrec =+  T.mkVariable tTimeBuiltinTypes 290036 290039 3 2 "showsPrec" Prelude.False++a8v26v8v28localFromEnum =+  T.mkVariable tTimeBuiltinTypes 80026 80028 3 1 "localFromEnum" Prelude.True++a8v46v8v47localToEnum =+  T.mkVariable tTimeBuiltinTypes 80046 80047 3 1 "localToEnum" Prelude.True++a8v46v8v47localFromEnum =+  T.mkVariable tTimeBuiltinTypes 80046 80047 3 1 "localFromEnum" Prelude.True++a12v26v12v28localFromEnum =+  T.mkVariable tTimeBuiltinTypes 120026 120028 3 1 "localFromEnum" Prelude.True++a12v46v12v47localToEnum =+  T.mkVariable tTimeBuiltinTypes 120046 120047 3 1 "localToEnum" Prelude.True++a12v46v12v47localFromEnum =+  T.mkVariable tTimeBuiltinTypes 120046 120047 3 1 "localFromEnum" Prelude.True++a24v25v24v27localFromEnum =+  T.mkVariable tTimeBuiltinTypes 240025 240027 3 1 "localFromEnum" Prelude.True++a29v25v29v27localFromEnum =+  T.mkVariable tTimeBuiltinTypes 290025 290027 3 1 "localFromEnum" Prelude.True
+ Hat/hat-c.c view
@@ -0,0 +1,2237 @@+/* Primitive functions for writing the ART trace */++/* Control C interruption not yet implemented */++/* highest bit of fileoffset is used to mark those pointing to hidden nodes */++#include <stdio.h>+#include <stdlib.h>+#include <string.h>+#include <signal.h>+#include "ntohl.h"+#include "hat-c.h"+++#if defined(DEBUG)+#define HIDE(x) x+#define CHECKCOUNTER(name) if (HatCounter != ftell(HatFile)) { fprintf(stderr,"wrong %s 0x%x 0x%x\n",name,HatCounter,ftell(HatFile)); exit(-1);}+#else+#define HIDE(x)+#define CHECKCOUNTER(name)+#endif++/* forward references */+static void initBuffers();+static FileOffset writeTag (int tag, int size);+static void writeByte (int byte);+static void writeFileOffset (FileOffset offset);+static void writeInt (int number);+static void writeFloat (float number);+static void writeDouble (double number);+static void updateFileOffset (FileOffset at, FileOffset entry); +static int stringSize(char *s);+static void writeString(char *s);+static void dumpBuffers();+static void initHiddenChildrenSet();+static void dumpHiddenChildrenSet();+++/* fileoffset indication end of list */+#define LISTEND ((FileOffset) 0)++/* global variables */++#define HeaderSize (8 + 2*sizeof(FileOffset))+typedef char byte;++static FILE *HatFile, *HatOutput, *HatBridge;+static FileOffset HatCounter = HeaderSize;+static FileOffset LastExp = 0;+static Bool traceOpen = False;+static Bool atTraceEnd = True;+static Bool controlC = False;+static FileOffset hiddenMask;+static FileOffset unevaluated;+static FileOffset entered;++/* helper functions */++/*+void+writeString(char *s)+{+  int length = strlen(s);+  if (length < 255)+    fputc(length,HatFile);+  else {+    fputc(255,HatFile);+    fputc((unsigned char) (length>>8),HatFile); +    fputc((unsigned char) length,HatFile);+  }+  fprintf(HatFile,"%s",s);+}+*/++/* catching errors of the runtime system */++#if defined(__GLASGOW_HASKELL__)+void+OutOfHeapHook (unsigned long x, unsigned long y)+{ hat_ErrorExit("Run out of heap memory.", hat_topStack(), -1); }++void +StackOverflowHook (long int x)+{ hat_ErrorExit("Run out of stack memory.", hat_topStack(), -1); }++void +MallocFailHook (long int x)+{ hat_ErrorExit("Cannot allocate enough memory.", hat_topStack(), -1); }+#endif++#if defined(__NHC__) +extern void (*haskellErrorHandler)(char *errorMsg);+#endif ++/* general functions */++void +hat_Open(char *progname)+{+    FileOffset p = 0;+    char filename[256];++    unevaluated = htonl(Unevaluated);+    entered = htonl(Entered);    +    +    hiddenMask = htonl(~(1<<31)); /* only 0 at highest bit */+    /* logical & with possibly hidden fileoffset yields fileoffset */++    strcpy(filename,progname);+    strcat(filename,".hat");		/* the .hat file holds the archive */+    HatFile = fopen(filename,"wb");	/* of redex trails */+    p = ftell(HatFile);                 /* should be 0 */+    fprintf(HatFile,"Hat%s",FILEVERSION);	/* initialise file */+    fputc(0,HatFile);+    fwrite(&p,sizeof(FileOffset),1,HatFile);+    fwrite(&p,sizeof(FileOffset),1,HatFile);++    initBuffers();+    initHiddenChildrenSet();++    strcpy(filename,progname);		/* the .output file is a copy of */+    strcat(filename,".hat.output");	/* stdout */+    HatOutput = fopen(filename,"wb");+    strcpy(filename,progname);		/* the .bridge file links the output */+    strcat(filename,".hat.bridge");	/* to the archived trails */+    HatBridge = fopen(filename,"wb");++    controlC = False;+    /* SIGQUIT here before, why? */+#if defined(SIGQUIT)+    signal(SIGQUIT, hat_Interrupt);    /* install handler for abortion? */+#endif+    signal(SIGABRT, hat_Interrupt);    /* install handler for abortion? */+    signal(SIGFPE, hat_ArithmeticError);+    signal(SIGINT, hat_Interrupt); /* install handler for Control-C */++#if defined(__NHC__) +    haskellErrorHandler = hat_Error;+#endif +    traceOpen = True;+}++void hat_Close(void)+{+  if (!traceOpen) +    return;+  dumpHiddenChildrenSet();+  dumpBuffers();+  hat_dumpBuffer();+  fclose(HatFile);+  fclose(HatOutput);+  fclose(HatBridge);+  traceOpen = False;+}++void hat_ErrorClose(char* errmsg, FileOffset trace)+{+  FileOffset nt;++  if (!traceOpen) +    return;++  nt = mkAbstract(errmsg);+  nt &= hiddenMask;+  trace &= hiddenMask;+  fseek(HatFile,8,SEEK_SET);+  fwrite(&trace, sizeof(FileOffset), 1, HatFile);+  fwrite(&nt, sizeof(FileOffset), 1, HatFile);++  hat_dumpStack();+  hat_Close();+}++void hat_Error(char* errmsg)+{+  hat_ErrorClose(errmsg,hat_topStack());+}++void+hat_ErrorExit(char* errmsg, FileOffset trace, int ecode)+{+  fflush(stdout);+  fprintf(stderr, "\nError: %s\n", errmsg);+  hat_ErrorClose(errmsg,trace);+  exit(ecode);	+}++void +hat_Abort(char *msg)+{ hat_ErrorExit(msg, hat_topStack(), -1); }++void+hat_InterruptExit()+{+  FileOffset node = hat_topStack();++  fflush(stdout);+  fprintf(stderr, "Interrupted\n");++  fseek(HatFile,8,SEEK_SET);+  fwrite(&node, sizeof(FileOffset), 1, HatFile);+  fwrite(&entered, sizeof(FileOffset), 1, HatFile);++  hat_dumpStack();+  hat_Close();++  exit(-1);	+}++void +hat_Interrupt(int sig)+{ controlC = True; }++void+hat_ArithmeticError(int sig)+{ hat_Abort("Arithmetic error."); }+++void hat_OutputTrace(FileOffset trace, char *output)+{+  fprintf(HatOutput,"%s",output);  /* copy of output */+  trace &= hiddenMask;+  while (*output++) {+    fwrite(&trace, sizeof(FileOffset), 1, HatBridge);+				/* link trace to output */+  }+}++Bool+hat_Hidden(FileOffset node)+{+  return (!((node & hiddenMask) == node));+}++FileOffset+mkRoot()+{+  return (htonl(Root));+}+++/* Write trace nodes */++FileOffset+mkModule(char *modname, char *srcfile, Bool traced)+{+  FileOffset fo;++  fo = writeTag(Module | (traced?TracedModule:0)+               ,1+stringSize(modname)+stringSize(srcfile));+  writeString(modname);+  writeString(srcfile);+  HIDE(fprintf(stderr,"\tmkModule %s (%s) -> 0x%x\n",modname,srcfile,fo);)+  return fo;+}++FileOffset+mkSrcPos(FileOffset moduleTraceInfo,int begin,int end)+{+  FileOffset fo;++  fo = writeTag(SrcPos,1+sizeof(FileOffset)+2*sizeof(int));+  writeFileOffset(moduleTraceInfo);+  writeInt(begin);+  writeInt(end);+  HIDE(fprintf(stderr,"\tmkSrcPos %d %d -> 0x%x\n",begin,end,fo);)+  return fo;+}+++/* Exp nodes; if use is 0, then the variant without a use field is written */++FileOffset+mkResApp1(FileOffset parent,FileOffset use,FileOffset fun+         ,FileOffset arg1)+{+  FileOffset fo;++  fo = writeTag(ExpApp | (use?HasSrcPos:0)+	       ,2 + (4*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if (use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(fo);+  writeFileOffset(fun);+  writeByte(1);+  writeFileOffset(arg1);+  HIDE(fprintf(stderr,"\tmkResApp1 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,fo,fun,arg1,fo);)+  return fo;+}++FileOffset+mkApp1(FileOffset parent,FileOffset use,FileOffset fun+      ,FileOffset arg1)+{+  FileOffset fo;++  fo = writeTag(ExpApp | (use?HasSrcPos:0)+	       ,2 + (4*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(fun);+  writeByte(1);+  writeFileOffset(arg1);+  HIDE(fprintf(stderr,"\tmkApp1 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,fun,arg1,fo);)+  return fo;+}++FileOffset+mkApp2(FileOffset parent,FileOffset use,FileOffset fun+      ,FileOffset arg1,FileOffset arg2)+{+  FileOffset fo;++  fo = writeTag(ExpApp | (use?HasSrcPos:0)+	       ,2 + (5*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(fun);+  writeByte(2);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  HIDE(fprintf(stderr,"\tmkApp2 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,fun,arg1,arg2,fo);)+  return fo;+}++FileOffset+mkApp3(FileOffset parent,FileOffset use,FileOffset fun+      ,FileOffset arg1,FileOffset arg2,FileOffset arg3)+{+  FileOffset fo;++  fo = writeTag(ExpApp | (use?HasSrcPos:0)+	       ,2 + (6*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(fun);+  writeByte(3);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  HIDE(fprintf(stderr,"\tmkApp3 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,fun,arg1,arg2,arg3,fo);)+  return fo;+}++FileOffset+mkApp4(FileOffset parent,FileOffset use,FileOffset fun+      ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4)+{+  FileOffset fo;++  fo = writeTag(ExpApp | (use?HasSrcPos:0)+	       ,2 + (7*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(fun);+  writeByte(4);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  writeFileOffset(arg4);+  HIDE(fprintf(stderr,"\tmkApp4 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,fun,arg1,arg2,arg3,arg4,fo);)+  return fo;+}++FileOffset+mkApp5(FileOffset parent,FileOffset use,FileOffset fun+      ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+      ,FileOffset arg5)+{+  FileOffset fo;++  fo = writeTag(ExpApp | (use?HasSrcPos:0)+	       ,2 + (8*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(fun);+  writeByte(5);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  writeFileOffset(arg4);+  writeFileOffset(arg5);+  HIDE(fprintf(stderr,"\tmkApp5 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,fun,arg1,arg2,arg3,arg4,arg5,fo);)+  return fo;+}++FileOffset+mkApp6(FileOffset parent,FileOffset use,FileOffset fun+      ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+      ,FileOffset arg5,FileOffset arg6)+{+  FileOffset fo;++  fo = writeTag(ExpApp | (use?HasSrcPos:0)+	       ,2 + (9*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(fun);+  writeByte(6);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  writeFileOffset(arg4);+  writeFileOffset(arg5);+  writeFileOffset(arg6);+  HIDE(fprintf(stderr,"\tmkApp6 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,fun,arg1,arg2,arg3,arg4,arg5,arg6,fo);)+  return fo;+}++FileOffset+mkApp7(FileOffset parent,FileOffset use,FileOffset fun+      ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+      ,FileOffset arg5,FileOffset arg6,FileOffset arg7)+{+  FileOffset fo;++  fo = writeTag(ExpApp | (use?HasSrcPos:0)+	       ,2 + (10*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(fun);+  writeByte(7);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  writeFileOffset(arg4);+  writeFileOffset(arg5);+  writeFileOffset(arg6);+  writeFileOffset(arg7);+  HIDE(fprintf(stderr,"\tmkApp7 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,fun,arg1,arg2,arg3,arg4,arg5,arg6,arg7,fo);)+  return fo;+}++FileOffset+mkApp8(FileOffset parent,FileOffset use,FileOffset fun+      ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+      ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8)+{+  FileOffset fo;++  fo = writeTag(ExpApp | (use?HasSrcPos:0)+	       ,2 + (11*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(fun);+  writeByte(8);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  writeFileOffset(arg4);+  writeFileOffset(arg5);+  writeFileOffset(arg6);+  writeFileOffset(arg7);+  writeFileOffset(arg8);+  HIDE(fprintf(stderr,"\tmkApp8 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,fun,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,fo);)+  return fo;+}++FileOffset+mkApp9(FileOffset parent,FileOffset use,FileOffset fun+      ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+      ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+      ,FileOffset arg9)+{+  FileOffset fo;++  fo = writeTag(ExpApp | (use?HasSrcPos:0)+	       ,2 + (12*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(fun);+  writeByte(9);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  writeFileOffset(arg4);+  writeFileOffset(arg5);+  writeFileOffset(arg6);+  writeFileOffset(arg7);+  writeFileOffset(arg8);+  writeFileOffset(arg9);+  HIDE(fprintf(stderr,"\tmkApp9 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,fun,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9,fo);)+  return fo;+}++FileOffset+mkApp10(FileOffset parent,FileOffset use,FileOffset fun+       ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+       ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+       ,FileOffset arg9,FileOffset arg10)+{+  FileOffset fo;++  fo = writeTag(ExpApp | (use?HasSrcPos:0)+	       ,2 + (13*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(fun);+  writeByte(10);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  writeFileOffset(arg4);+  writeFileOffset(arg5);+  writeFileOffset(arg6);+  writeFileOffset(arg7);+  writeFileOffset(arg8);+  writeFileOffset(arg9);+  writeFileOffset(arg10);+  HIDE(fprintf(stderr,"\tmkApp10 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,fun,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9,arg10,fo);)+  return fo;+}++FileOffset+mkApp11(FileOffset parent,FileOffset use,FileOffset fun+       ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+       ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+       ,FileOffset arg9,FileOffset arg10,FileOffset arg11)+{+  FileOffset fo;++  fo = writeTag(ExpApp | (use?HasSrcPos:0)+	       ,2 + (14*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(fun);+  writeByte(11);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  writeFileOffset(arg4);+  writeFileOffset(arg5);+  writeFileOffset(arg6);+  writeFileOffset(arg7);+  writeFileOffset(arg8);+  writeFileOffset(arg9);+  writeFileOffset(arg10);+  writeFileOffset(arg11);+  HIDE(fprintf(stderr,"\tmkApp11 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,fun,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9,arg10,arg11,fo);)+  return fo;+}++FileOffset+mkApp12(FileOffset parent,FileOffset use,FileOffset fun+       ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+       ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+       ,FileOffset arg9,FileOffset arg10,FileOffset arg11,FileOffset arg12)+{+  FileOffset fo;++  fo = writeTag(ExpApp | (use?HasSrcPos:0)+	       ,2 + (15*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(fun);+  writeByte(12);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  writeFileOffset(arg4);+  writeFileOffset(arg5);+  writeFileOffset(arg6);+  writeFileOffset(arg7);+  writeFileOffset(arg8);+  writeFileOffset(arg9);+  writeFileOffset(arg10);+  writeFileOffset(arg11);+  writeFileOffset(arg12);+  HIDE(fprintf(stderr,"\tmkApp12 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,fun,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9,arg10,arg11,arg12,fo);)+  return fo;+}++FileOffset+mkApp13(FileOffset parent,FileOffset use,FileOffset fun+       ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+       ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+       ,FileOffset arg9,FileOffset arg10,FileOffset arg11,FileOffset arg12+       ,FileOffset arg13)+{+  FileOffset fo;++  fo = writeTag(ExpApp | (use?HasSrcPos:0)+	       ,2 + (16*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(fun);+  writeByte(13);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  writeFileOffset(arg4);+  writeFileOffset(arg5);+  writeFileOffset(arg6);+  writeFileOffset(arg7);+  writeFileOffset(arg8);+  writeFileOffset(arg9);+  writeFileOffset(arg10);+  writeFileOffset(arg11);+  writeFileOffset(arg12);+  writeFileOffset(arg13);+  HIDE(fprintf(stderr,"\tmkApp13 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,fun,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9,arg10,arg11,arg12,arg13,fo);)+  return fo;+}++FileOffset+mkApp14(FileOffset parent,FileOffset use,FileOffset fun+       ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+       ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+       ,FileOffset arg9,FileOffset arg10,FileOffset arg11,FileOffset arg12+       ,FileOffset arg13,FileOffset arg14)+{+  FileOffset fo;++  fo = writeTag(ExpApp | (use?HasSrcPos:0)+	       ,2 + (17*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(fun);+  writeByte(14);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  writeFileOffset(arg4);+  writeFileOffset(arg5);+  writeFileOffset(arg6);+  writeFileOffset(arg7);+  writeFileOffset(arg8);+  writeFileOffset(arg9);+  writeFileOffset(arg10);+  writeFileOffset(arg11);+  writeFileOffset(arg12);+  writeFileOffset(arg13);+  writeFileOffset(arg14);+  HIDE(fprintf(stderr,"\tmkApp14 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,fun,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9,arg10,arg11,arg12,arg13,arg14,fo);)+  return fo;+}++FileOffset+mkApp15(FileOffset parent,FileOffset use,FileOffset fun+       ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+       ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+       ,FileOffset arg9,FileOffset arg10,FileOffset arg11,FileOffset arg12+       ,FileOffset arg13,FileOffset arg14,FileOffset arg15)+{+  FileOffset fo;++  fo = writeTag(ExpApp | (use?HasSrcPos:0)+	       ,2 + (18*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(fun);+  writeByte(15);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  writeFileOffset(arg4);+  writeFileOffset(arg5);+  writeFileOffset(arg6);+  writeFileOffset(arg7);+  writeFileOffset(arg8);+  writeFileOffset(arg9);+  writeFileOffset(arg10);+  writeFileOffset(arg11);+  writeFileOffset(arg12);+  writeFileOffset(arg13);+  writeFileOffset(arg14);+  writeFileOffset(arg15);+  HIDE(fprintf(stderr,"\tmkApp15 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,fun,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9,arg10,arg11,arg12,arg13,arg14,arg15,fo);)+  return fo;+}++FileOffset+mkValueApp1(FileOffset parent,FileOffset use,FileOffset fun+      ,FileOffset arg1)+{+  FileOffset fo;++  fo = writeTag(ExpValueApp | (use?HasSrcPos:0)+	       ,2 + (3*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(fun);+  writeByte(1);+  writeFileOffset(arg1);+  HIDE(fprintf(stderr,"\tmkValueApp1 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,fun,arg1,fo);)+  return fo;+}++FileOffset+mkValueApp2(FileOffset parent,FileOffset use,FileOffset fun+      ,FileOffset arg1,FileOffset arg2)+{+  FileOffset fo;++  fo = writeTag(ExpValueApp | (use?HasSrcPos:0)+		,2 + (4*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(fun);+  writeByte(2);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  HIDE(fprintf(stderr,"\tmkValueApp2 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,fun,arg1,arg2,fo);)+  return fo;+}++FileOffset+mkValueApp3(FileOffset parent,FileOffset use,FileOffset fun+      ,FileOffset arg1,FileOffset arg2,FileOffset arg3)+{+  FileOffset fo;++  fo = writeTag(ExpValueApp | (use?HasSrcPos:0)+	       ,2 + (5*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(fun);+  writeByte(3);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  HIDE(fprintf(stderr,"\tmkValueApp3 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,fun,arg1,arg2,arg3,fo);)+  return fo;+}++FileOffset+mkValueApp4(FileOffset parent,FileOffset use,FileOffset fun+      ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4)+{+  FileOffset fo;++  fo = writeTag(ExpValueApp | (use?HasSrcPos:0)+	       ,2 + (6*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(fun);+  writeByte(4);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  writeFileOffset(arg4);+  HIDE(fprintf(stderr,"\tmkValueApp4 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,fun,arg1,arg2,arg3,arg4,fo);)+  return fo;+}++FileOffset+mkValueApp5(FileOffset parent,FileOffset use,FileOffset fun+      ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+      ,FileOffset arg5)+{+  FileOffset fo;+  +  fo = writeTag(ExpValueApp | (use?HasSrcPos:0)+	       ,2 + (7*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(fun);+  writeByte(5);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  writeFileOffset(arg4);+  writeFileOffset(arg5);+  HIDE(fprintf(stderr,"\tmkValueApp5 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,fun,arg1,arg2,arg3,arg4,arg5,fo);)+  return fo;+}++FileOffset+mkValueApp6(FileOffset parent,FileOffset use,FileOffset fun+      ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+      ,FileOffset arg5,FileOffset arg6)+{+  FileOffset fo;++  fo = writeTag(ExpValueApp | (use?HasSrcPos:0)+	       ,2 + (8*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(fun);+  writeByte(6);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  writeFileOffset(arg4);+  writeFileOffset(arg5);+  writeFileOffset(arg6);+  HIDE(fprintf(stderr,"\tmkValueApp6 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,fun,arg1,arg2,arg3,arg4,arg5,arg6,fo);)+  return fo;+}++FileOffset+mkValueApp7(FileOffset parent,FileOffset use,FileOffset fun+      ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+      ,FileOffset arg5,FileOffset arg6,FileOffset arg7)+{+  FileOffset fo;++  fo = writeTag(ExpValueApp | (use?HasSrcPos:0)+	       ,2 + (9*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(fun);+  writeByte(7);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  writeFileOffset(arg4);+  writeFileOffset(arg5);+  writeFileOffset(arg6);+  writeFileOffset(arg7);+  HIDE(fprintf(stderr,"\tmkValueApp7 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,fun,arg1,arg2,arg3,arg4,arg5,arg6,arg7,fo);)+  return fo;+}++FileOffset+mkValueApp8(FileOffset parent,FileOffset use,FileOffset fun+      ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+      ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8)+{+  FileOffset fo;++  fo = writeTag(ExpValueApp | (use?HasSrcPos:0)+	       ,2 + (10*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(fun);+  writeByte(8);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  writeFileOffset(arg4);+  writeFileOffset(arg5);+  writeFileOffset(arg6);+  writeFileOffset(arg7);+  writeFileOffset(arg8);+  HIDE(fprintf(stderr,"\tmkValueApp8 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,fun,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,LastExp);)+  return fo;+}++FileOffset+mkValueApp9(FileOffset parent,FileOffset use,FileOffset fun+      ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+      ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+      ,FileOffset arg9)+{+  FileOffset fo;++  fo = writeTag(ExpValueApp | (use?HasSrcPos:0)+	       ,2 + (11*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(fun);+  writeByte(9);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  writeFileOffset(arg4);+  writeFileOffset(arg5);+  writeFileOffset(arg6);+  writeFileOffset(arg7);+  writeFileOffset(arg8);+  writeFileOffset(arg9);+  HIDE(fprintf(stderr,"\tmkValueApp9 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,fun,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9,LastExp);)+  return fo;+}++FileOffset+mkValueApp10(FileOffset parent,FileOffset use,FileOffset fun+      ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+      ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+      ,FileOffset arg9,FileOffset arg10)+{+  FileOffset fo;++  fo = writeTag(ExpValueApp | (use?HasSrcPos:0)+	       ,2 + (12*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(fun);+  writeByte(10);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  writeFileOffset(arg4);+  writeFileOffset(arg5);+  writeFileOffset(arg6);+  writeFileOffset(arg7);+  writeFileOffset(arg8);+  writeFileOffset(arg9);+  writeFileOffset(arg10);+  HIDE(fprintf(stderr,"\tmkValueApp10 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,fun,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9,arg10,LastExp);)+  return fo;+}++FileOffset+mkValueApp11(FileOffset parent,FileOffset use,FileOffset fun+      ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+      ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+      ,FileOffset arg9,FileOffset arg10,FileOffset arg11)+{+  FileOffset fo;++  fo = writeTag(ExpValueApp | (use?HasSrcPos:0)+	       ,2 + (13*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(fun);+  writeByte(11);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  writeFileOffset(arg4);+  writeFileOffset(arg5);+  writeFileOffset(arg6);+  writeFileOffset(arg7);+  writeFileOffset(arg8);+  writeFileOffset(arg9);+  writeFileOffset(arg10);+  writeFileOffset(arg11);+  HIDE(fprintf(stderr,"\tmkValueApp11 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,fun,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9,arg10,arg11,LastExp);)+  return fo;+}++FileOffset+mkValueApp12(FileOffset parent,FileOffset use,FileOffset fun+      ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+      ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+      ,FileOffset arg9,FileOffset arg10,FileOffset arg11,FileOffset arg12)+{+  FileOffset fo;++  fo = writeTag(ExpValueApp | (use?HasSrcPos:0)+	       ,2 + (14*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(fun);+  writeByte(12);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  writeFileOffset(arg4);+  writeFileOffset(arg5);+  writeFileOffset(arg6);+  writeFileOffset(arg7);+  writeFileOffset(arg8);+  writeFileOffset(arg9);+  writeFileOffset(arg10);+  writeFileOffset(arg11);+  writeFileOffset(arg12);+  HIDE(fprintf(stderr,"\tmkValueApp12 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,fun,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9,arg10,arg11,arg12,LastExp);)+  return fo;+}++FileOffset+mkValueApp13(FileOffset parent,FileOffset use,FileOffset fun+      ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+      ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+      ,FileOffset arg9,FileOffset arg10,FileOffset arg11,FileOffset arg12+      ,FileOffset arg13)+{+  FileOffset fo;++  fo = writeTag(ExpValueApp | (use?HasSrcPos:0)+	       ,2 + (15*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(fun);+  writeByte(13);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  writeFileOffset(arg4);+  writeFileOffset(arg5);+  writeFileOffset(arg6);+  writeFileOffset(arg7);+  writeFileOffset(arg8);+  writeFileOffset(arg9);+  writeFileOffset(arg10);+  writeFileOffset(arg11);+  writeFileOffset(arg12);+  writeFileOffset(arg13);+  HIDE(fprintf(stderr,"\tmkValueApp13 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,fun,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9,arg10,arg11,arg12,arg13,LastExp);)+  return fo;+}++FileOffset+mkValueApp14(FileOffset parent,FileOffset use,FileOffset fun+      ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+      ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+      ,FileOffset arg9,FileOffset arg10,FileOffset arg11,FileOffset arg12+      ,FileOffset arg13,FileOffset arg14)+{+  FileOffset fo;++  fo = writeTag(ExpValueApp | (use?HasSrcPos:0)+	       ,2 + (16*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(fun);+  writeByte(14);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  writeFileOffset(arg4);+  writeFileOffset(arg5);+  writeFileOffset(arg6);+  writeFileOffset(arg7);+  writeFileOffset(arg8);+  writeFileOffset(arg9);+  writeFileOffset(arg10);+  writeFileOffset(arg11);+  writeFileOffset(arg12);+  writeFileOffset(arg13);+  writeFileOffset(arg14);+  HIDE(fprintf(stderr,"\tmkValueApp14 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,fun,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9,arg10,arg11,arg12,arg13,arg14,LastExp);)+  return fo;+}++FileOffset+mkValueApp15(FileOffset parent,FileOffset use,FileOffset fun+      ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+      ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+      ,FileOffset arg9,FileOffset arg10,FileOffset arg11,FileOffset arg12+      ,FileOffset arg13,FileOffset arg14,FileOffset arg15)+{+  FileOffset fo;++  fo = writeTag(ExpValueApp | (use?HasSrcPos:0)+	       ,2 + (17*sizeof(FileOffset)) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(fun);+  writeByte(15);+  writeFileOffset(arg1);+  writeFileOffset(arg2);+  writeFileOffset(arg3);+  writeFileOffset(arg4);+  writeFileOffset(arg5);+  writeFileOffset(arg6);+  writeFileOffset(arg7);+  writeFileOffset(arg8);+  writeFileOffset(arg9);+  writeFileOffset(arg10);+  writeFileOffset(arg11);+  writeFileOffset(arg12);+  writeFileOffset(arg13);+  writeFileOffset(arg14);+  writeFileOffset(arg15);+  HIDE(fprintf(stderr,"\tmkValueApp15 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,fun,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9,arg10,arg11,arg12,arg13,arg14,arg15,LastExp);)+  return fo;+}++FileOffset+mkChar(FileOffset parent,FileOffset use,char c)+{+  FileOffset fo;++  fo = writeTag(ExpChar | (use?HasSrcPos:0)+	       ,1 + sizeof(FileOffset) + sizeof(char)+                + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeByte(c);+  HIDE(fprintf(stderr,"\tmkChar 0x%x 0x%x %c -> 0x%x\n",parent,use,c,fo);)+  return fo;+}++FileOffset+mkInt(FileOffset parent,FileOffset use,int i)+{+  FileOffset fo;++  fo = writeTag(ExpInt | (use?HasSrcPos:0)+	       ,1 + sizeof(FileOffset) + sizeof(int) +                + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeInt(i);  +  HIDE(fprintf(stderr,"\tmkInt 0x%x 0x%x %d -> 0x%x\n",parent,use,i,fo);)+  return fo;+}++FileOffset+mkInteger(FileOffset parent,FileOffset use,char *i)+{+  FileOffset fo;++  fo = writeTag(ExpInteger | (use?HasSrcPos:0)+	       ,1 + sizeof(FileOffset) + stringSize(i) +		+ (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeString(i);+  HIDE(fprintf(stderr,"\tmkInteger 0x%x 0x%x %s -> 0x%x\n",parent,use,i,fo);)+  return fo;+}++FileOffset+mkRat(FileOffset parent,FileOffset use,int num,int denom)+{+  FileOffset fo;++  fo = writeTag(ExpRat | (use?HasSrcPos:0)+	       ,1 + sizeof(FileOffset) + 2*sizeof(int) +                + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeInt(num);+  writeInt(denom);+  HIDE(fprintf(stderr,"\tmkRat 0x%x 0x%x %d/%d -> 0x%x\n",parent,use,num,denom,fo);)+  return fo;+}++FileOffset+mkRational(FileOffset parent,FileOffset use+          ,char *num,char *denom)+{+  FileOffset fo;++  fo = writeTag(ExpRational | (use?HasSrcPos:0)+	       ,1+ sizeof(FileOffset) + stringSize(num) + stringSize(denom)+                + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeString(num);+  writeString(denom);+  HIDE(fprintf(stderr,"\tmkRational 0x%x 0x%x %s/%s -> 0x%x\n",parent,use,num,denom,fo);)+  return fo;+}++FileOffset+mkFloat(FileOffset parent,FileOffset use,float f)+{+  FileOffset fo;++  fo = writeTag(ExpFloat | (use?HasSrcPos:0)+	       ,1 + sizeof(FileOffset) + sizeof(float) +		+ (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFloat(f);+  HIDE(fprintf(stderr,"\tmkFloat 0x%x 0x%x %f -> 0x%x\n",parent,use,f,fp);)+  return fo;+}++FileOffset+mkDouble(FileOffset parent,FileOffset use,double d)+{+  FileOffset fo;++  fo = writeTag(ExpDouble | (use?HasSrcPos:0)+	       ,1 + sizeof(FileOffset) + sizeof(double) +		+ (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeDouble(d);+  HIDE(fprintf(stderr,"\tmkDouble 0x%x 0x%x %f -> 0x%x\n",parent,use,d,fo);)+  return fo;+}++FileOffset+mkValueUse(FileOffset parent,FileOffset use,FileOffset value)+{+  FileOffset fo;++  fo = writeTag(ExpValueUse | (use?HasSrcPos:0)+	       ,1 + 2*sizeof(FileOffset) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(value);+  HIDE(fprintf(stderr,"\tmkValueUse 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,value,fo);)+  return fo;+}++FileOffset+mkConstUse(FileOffset parent,FileOffset use,FileOffset con)+{+  FileOffset fo;++  fo = writeTag(ExpConstUse | (use?HasSrcPos:0)+	       , 1 + 2*sizeof(FileOffset) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(con);+  HIDE(fprintf(stderr,"\tmkConstUse 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,con,fo);)+  return fo;+}++FileOffset+mkConstDef(FileOffset context,FileOffset var)+{+  FileOffset fo;++  fo = writeTag(ExpConstDef, 1 + 3*sizeof(FileOffset));+  writeFileOffset(context);+  writeFileOffset(unevaluated);+  writeFileOffset(var);+  HIDE(fprintf(stderr,"\tmkConstDef 0x%x 0x%x -> 0x%x\n",context,var,fo);)+  return fo;+}+++FileOffset+mkGuard(FileOffset parent,FileOffset use,FileOffset cond)+{+  FileOffset fo;++  fo = writeTag(ExpGuard | (use?HasSrcPos:0)+	       ,1 + 3*sizeof(FileOffset) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(cond);  +  HIDE(fprintf(stderr,"\tmkGuard 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,unevaluated,cond,fo);)+  return fo;+}++FileOffset+mkCase(FileOffset parent,FileOffset use,FileOffset cond)+{+  FileOffset fo;++  fo = writeTag(ExpCase | (use?HasSrcPos:0)+	       ,1 + 3*sizeof(FileOffset) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(cond);  +  HIDE(fprintf(stderr,"\tmkCase 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,cond,fo);)+  return fo;+}++FileOffset+mkIf(FileOffset parent,FileOffset use,FileOffset cond)+{+  FileOffset fo;++  fo = writeTag(ExpIf | (use?HasSrcPos:0)+	       ,1 + 3*sizeof(FileOffset) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(cond);  +  HIDE(fprintf(stderr,"\tmkIf 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,cond,fo);)+  return fo;+}++FileOffset+mkFieldUpdate1(FileOffset parent,FileOffset use+              ,FileOffset arg,FileOffset binder1,FileOffset bindee1)+{+  FileOffset fo;++  fo = writeTag(ExpFieldUpdate | (use?HasSrcPos:0)+	       ,2 + 5*sizeof(FileOffset) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(arg);+  writeByte(1);+  writeFileOffset(binder1);+  writeFileOffset(bindee1);+  HIDE(fprintf(stderr,"\tmkFieldUpdate1 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,arg,binder1,bindee1,fo);)+  return fo;+}+++FileOffset+mkFieldUpdate2(FileOffset parent,FileOffset use+              ,FileOffset arg,FileOffset binder1,FileOffset bindee1+              ,FileOffset binder2,FileOffset bindee2)+{+  FileOffset fo;++  fo = writeTag(ExpFieldUpdate | (use?HasSrcPos:0)+	       ,2 + 7*sizeof(FileOffset) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(arg);+  writeByte(2);+  writeFileOffset(binder1);+  writeFileOffset(bindee1);+  writeFileOffset(binder2);+  writeFileOffset(bindee2);+  HIDE(fprintf(stderr,"\tmkFieldUpdate2 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,arg,binder1,bindee1,binder2,bindee2,fo);)+  return fo;+}++FileOffset+mkFieldUpdate3(FileOffset parent,FileOffset use+              ,FileOffset arg,FileOffset binder1,FileOffset bindee1+              ,FileOffset binder2,FileOffset bindee2+              ,FileOffset binder3,FileOffset bindee3)+{+  FileOffset fo;++  fo = writeTag(ExpFieldUpdate | (use?HasSrcPos:0)+	       ,2 + 9*sizeof(FileOffset) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(arg);+  writeByte(3);+  writeFileOffset(binder1);+  writeFileOffset(bindee1);+  writeFileOffset(binder2);+  writeFileOffset(bindee2);+  writeFileOffset(binder3);+  writeFileOffset(bindee3);+  HIDE(fprintf(stderr,"\tmkFieldUpdate3 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,arg,binder1,bindee1,binder2,bindee2,binder3,bindee3,fo);)+  return fo;+}++FileOffset+mkFieldUpdate4(FileOffset parent,FileOffset use+              ,FileOffset arg,FileOffset binder1,FileOffset bindee1+              ,FileOffset binder2,FileOffset bindee2+              ,FileOffset binder3,FileOffset bindee3+              ,FileOffset binder4,FileOffset bindee4)+{+  FileOffset fo;++  fo = writeTag(ExpFieldUpdate | (use?HasSrcPos:0)+	       ,2 + 11*sizeof(FileOffset) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(arg);+  writeByte(4);+  writeFileOffset(binder1);+  writeFileOffset(bindee1);+  writeFileOffset(binder2);+  writeFileOffset(bindee2);+  writeFileOffset(binder3);+  writeFileOffset(bindee3);+  writeFileOffset(binder4);+  writeFileOffset(bindee4);+  HIDE(fprintf(stderr,"\tmkFieldUpdate4 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,arg,binder1,bindee1,binder2,bindee2,binder3,bindee3,binder4,bindee4,fo);)+  return fo;+}++FileOffset+mkFieldUpdate5(FileOffset parent,FileOffset use+              ,FileOffset arg,FileOffset binder1,FileOffset bindee1+              ,FileOffset binder2,FileOffset bindee2+              ,FileOffset binder3,FileOffset bindee3+              ,FileOffset binder4,FileOffset bindee4+              ,FileOffset binder5,FileOffset bindee5)+{+  FileOffset fo;++  fo = writeTag(ExpFieldUpdate | (use?HasSrcPos:0)+	       ,2 + 13*sizeof(FileOffset) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(arg);+  writeByte(5);+  writeFileOffset(binder1);+  writeFileOffset(bindee1);+  writeFileOffset(binder2);+  writeFileOffset(bindee2);+  writeFileOffset(binder3);+  writeFileOffset(bindee3);+  writeFileOffset(binder4);+  writeFileOffset(bindee4);+  writeFileOffset(binder5);+  writeFileOffset(bindee5);+  HIDE(fprintf(stderr,"\tmkFieldUpdate5 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,arg,binder1,bindee1,binder2,bindee2,binder3,bindee3,binder4,bindee4,binder5,bindee5,fo);)+  return fo;+}++FileOffset+mkFieldUpdate6(FileOffset parent,FileOffset use+              ,FileOffset arg,FileOffset binder1,FileOffset bindee1+              ,FileOffset binder2,FileOffset bindee2+              ,FileOffset binder3,FileOffset bindee3+              ,FileOffset binder4,FileOffset bindee4+              ,FileOffset binder5,FileOffset bindee5+              ,FileOffset binder6,FileOffset bindee6)+{+  FileOffset fo;++  fo = writeTag(ExpFieldUpdate | (use?HasSrcPos:0)+	       ,2 + 15*sizeof(FileOffset) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(arg);+  writeByte(6);+  writeFileOffset(binder1);+  writeFileOffset(bindee1);+  writeFileOffset(binder2);+  writeFileOffset(bindee2);+  writeFileOffset(binder3);+  writeFileOffset(bindee3);+  writeFileOffset(binder4);+  writeFileOffset(bindee4);+  writeFileOffset(binder5);+  writeFileOffset(bindee5);+  writeFileOffset(binder6);+  writeFileOffset(bindee6);+  HIDE(fprintf(stderr,"\tmkFieldUpdate6 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,arg,binder1,bindee1,binder2,bindee2,binder3,bindee3,binder4,bindee4,binder5,bindee5,binder6,bindee6,fo);)+  return fo;+}++FileOffset+mkFieldUpdate7(FileOffset parent,FileOffset use+              ,FileOffset arg,FileOffset binder1,FileOffset bindee1+              ,FileOffset binder2,FileOffset bindee2+              ,FileOffset binder3,FileOffset bindee3+              ,FileOffset binder4,FileOffset bindee4+              ,FileOffset binder5,FileOffset bindee5+              ,FileOffset binder6,FileOffset bindee6+              ,FileOffset binder7,FileOffset bindee7)+{+  FileOffset fo;++  fo = writeTag(ExpFieldUpdate | (use?HasSrcPos:0)+	       ,2 + 17*sizeof(FileOffset) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(arg);+  writeByte(7);+  writeFileOffset(binder1);+  writeFileOffset(bindee1);+  writeFileOffset(binder2);+  writeFileOffset(bindee2);+  writeFileOffset(binder3);+  writeFileOffset(bindee3);+  writeFileOffset(binder4);+  writeFileOffset(bindee4);+  writeFileOffset(binder5);+  writeFileOffset(bindee5);+  writeFileOffset(binder6);+  writeFileOffset(bindee6);+  writeFileOffset(binder7);+  writeFileOffset(bindee7);+  HIDE(fprintf(stderr,"\tmkFieldUpdate7 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,arg,binder1,bindee1,binder2,bindee2,binder3,bindee3,binder4,bindee4,binder5,bindee5,binder6,bindee6,binder7,bindee7,fo);)+  return fo;+}++FileOffset+mkFieldUpdate8(FileOffset parent,FileOffset use+              ,FileOffset arg,FileOffset binder1,FileOffset bindee1+              ,FileOffset binder2,FileOffset bindee2+              ,FileOffset binder3,FileOffset bindee3+              ,FileOffset binder4,FileOffset bindee4+              ,FileOffset binder5,FileOffset bindee5+              ,FileOffset binder6,FileOffset bindee6+              ,FileOffset binder7,FileOffset bindee7+              ,FileOffset binder8,FileOffset bindee8)+{+  FileOffset fo;++  fo = writeTag(ExpFieldUpdate | (use?HasSrcPos:0)+	       ,2 + 19*sizeof(FileOffset) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(arg);+  writeByte(8);+  writeFileOffset(binder1);+  writeFileOffset(bindee1);+  writeFileOffset(binder2);+  writeFileOffset(bindee2);+  writeFileOffset(binder3);+  writeFileOffset(bindee3);+  writeFileOffset(binder4);+  writeFileOffset(bindee4);+  writeFileOffset(binder5);+  writeFileOffset(bindee5);+  writeFileOffset(binder6);+  writeFileOffset(bindee6);+  writeFileOffset(binder7);+  writeFileOffset(bindee7);+  writeFileOffset(binder8);+  writeFileOffset(bindee8);+  HIDE(fprintf(stderr,"\tmkFieldUpdate8 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,arg,binder1,bindee1,binder2,bindee2,binder3,bindee3,binder4,bindee4,binder5,bindee5,binder6,bindee6,binder7,bindee7,binder8,bindee8,fo);)+  return fo;+}++FileOffset+mkFieldUpdate9(FileOffset parent,FileOffset use+              ,FileOffset arg,FileOffset binder1,FileOffset bindee1+              ,FileOffset binder2,FileOffset bindee2+              ,FileOffset binder3,FileOffset bindee3+              ,FileOffset binder4,FileOffset bindee4+              ,FileOffset binder5,FileOffset bindee5+              ,FileOffset binder6,FileOffset bindee6+              ,FileOffset binder7,FileOffset bindee7+              ,FileOffset binder8,FileOffset bindee8+              ,FileOffset binder9,FileOffset bindee9)+{+  FileOffset fo;++  fo = writeTag(ExpFieldUpdate | (use?HasSrcPos:0)+	       ,2 + 21*sizeof(FileOffset) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(arg);+  writeByte(9);+  writeFileOffset(binder1);+  writeFileOffset(bindee1);+  writeFileOffset(binder2);+  writeFileOffset(bindee2);+  writeFileOffset(binder3);+  writeFileOffset(bindee3);+  writeFileOffset(binder4);+  writeFileOffset(bindee4);+  writeFileOffset(binder5);+  writeFileOffset(bindee5);+  writeFileOffset(binder6);+  writeFileOffset(bindee6);+  writeFileOffset(binder7);+  writeFileOffset(bindee7);+  writeFileOffset(binder8);+  writeFileOffset(bindee8);+  writeFileOffset(binder9);+  writeFileOffset(bindee9);+  HIDE(fprintf(stderr,"\tmkFieldUpdate9 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,arg,binder1,bindee1,binder2,bindee2,binder3,bindee3,binder4,bindee4,binder5,bindee5,binder6,bindee6,binder7,bindee7,binder8,bindee8,binder9,bindee9,fo);)+  return fo;+}++FileOffset+mkFieldUpdate10(FileOffset parent,FileOffset use+              ,FileOffset arg,FileOffset binder1,FileOffset bindee1+              ,FileOffset binder2,FileOffset bindee2+              ,FileOffset binder3,FileOffset bindee3+              ,FileOffset binder4,FileOffset bindee4+              ,FileOffset binder5,FileOffset bindee5+              ,FileOffset binder6,FileOffset bindee6+              ,FileOffset binder7,FileOffset bindee7+              ,FileOffset binder8,FileOffset bindee8+              ,FileOffset binder9,FileOffset bindee9+              ,FileOffset binder10,FileOffset bindee10)+{+  FileOffset fo;++  fo = writeTag(ExpFieldUpdate | (use?HasSrcPos:0)+	       ,2 + 23*sizeof(FileOffset) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(arg);+  writeByte(10);+  writeFileOffset(binder1);+  writeFileOffset(bindee1);+  writeFileOffset(binder2);+  writeFileOffset(bindee2);+  writeFileOffset(binder3);+  writeFileOffset(bindee3);+  writeFileOffset(binder4);+  writeFileOffset(bindee4);+  writeFileOffset(binder5);+  writeFileOffset(bindee5);+  writeFileOffset(binder6);+  writeFileOffset(bindee6);+  writeFileOffset(binder7);+  writeFileOffset(bindee7);+  writeFileOffset(binder8);+  writeFileOffset(bindee8);+  writeFileOffset(binder9);+  writeFileOffset(bindee9);+  writeFileOffset(binder10);+  writeFileOffset(bindee10);+  HIDE(fprintf(stderr,"\tmkFieldUpdate10 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,Unevaluated,arg,binder1,bindee1,binder2,bindee2,binder3,bindee3,binder4,bindee4,binder5,bindee5,binder6,bindee6,binder7,bindee7,binder8,bindee8,binder9,bindee9,binder10,bindee10,fo);)+  return fo;+}++FileOffset+mkProjection(FileOffset parent,FileOffset use,FileOffset exp)+{+  FileOffset fo;++  fo = writeTag(ExpProjection | (use?HasSrcPos:0)+	       ,1 + 2*sizeof(FileOffset) + (use?sizeof(FileOffset):0));+  if(use)+    writeFileOffset(use);+  writeFileOffset(parent);+  writeFileOffset(exp);+  HIDE(fprintf(stderr,"\tmkProjection 0x%x 0x%x 0x%x -> 0x%x\n",parent,use,exp,fo);)+  return fo;+}++FileOffset+mkHidden(FileOffset parent)+{+  FileOffset fo = writeTag(ExpHidden,1 + 3*sizeof(FileOffset));+  writeFileOffset(parent);+  writeFileOffset(unevaluated);+  writeFileOffset(LISTEND);  /* initially empty child list */+  HIDE(fprintf(stderr,"\tmkHidden 0x%x 0x%x -> 0x%x\n",parent,Unevaluated,fo);)+  return (fo|~hiddenMask);+}++FileOffset+mkForward(FileOffset result)+{+  FileOffset fo;++  fo = writeTag(ExpForward,1 + sizeof(FileOffset));+  writeFileOffset(result);+  HIDE(fprintf(stderr,"\tmkForward 0x%x -> 0x%x\n",Unevaluated,fo);)+  return fo;+}++FileOffset+mkDoStmt(FileOffset stmt)+{+  FileOffset fo;++  fo = writeTag(ExpDoStmt, 1 + sizeof(FileOffset));+  writeFileOffset(stmt);+  HIDE(fprintf(stderr,"\tmkDoStmt 0x%x -> 0x%x\n",stmt,fo);)+  return fo;+}++/* Atom */++FileOffset+mkLambda()+{   return (htonl(Lambda)); }++FileOffset+mkDoLambda()+{   return (htonl(DoLambda)); }++FileOffset+mkVariable(FileOffset module,int begin,int end,int fixity,int arity,char *name+	  ,Bool local)+{+  FileOffset fo;++  fo = writeTag(AtomVariable | (local?LocalDef:0)+               ,1+sizeof(FileOffset)+2*sizeof(int)+2*sizeof(byte)+                +stringSize(name));+  writeFileOffset(module);+  writeInt(begin);+  writeInt(end);+  writeByte(fixity);+  writeByte(arity);+  writeString(name);+  HIDE(fprintf(stderr,"\tmkVariable 0x%x %d %d %d %d %s %d -> 0x%x\n",module,begin,end,fixity,arity,name,local,fo);)+  return fo;+}++FileOffset+mkConstructor(FileOffset module,int begin,int end,int fixity,int arity+             ,char *name)+{+  FileOffset fo;++  fo = writeTag(AtomConstructor+               ,1+sizeof(FileOffset)+2*sizeof(int)+2*sizeof(byte)+                +stringSize(name));+  writeFileOffset(module);+  writeInt(begin);+  writeInt(end);+  writeByte(fixity);+  writeByte(arity);+  writeString(name);+  HIDE(fprintf(stderr,"\tmkConstructor 0x%x %d %d %d %d %s %d -> 0x%x\n",module,begin,end,fixity,arity,name,fo);)+  return fo;+}++FileOffset+mkConstructorWFields(FileOffset module,int begin,int end,int fixity,int arity+                    ,char *name,FileOffset labels[])+{+  int i;+  FileOffset fo;++  fo = writeTag(AtomConstructor|HasFields+	       ,1+(1+arity)*sizeof(FileOffset)+2*sizeof(int)+2*sizeof(byte)+                +stringSize(name));+  writeFileOffset(module);+  writeInt(begin);+  writeInt(end);+  writeByte(fixity);+  writeByte(arity);+  writeString(name);+  for (i=0;i<arity;i++) +    writeFileOffset(labels[i]);+  HIDE(fprintf(stderr,"\tmkConstructorWFields 0x%x %d %d %d %d %s -> 0x%x\n",module,begin,end,fixity,arity,name,fo);)+  return fo;+}+++FileOffset+mkAbstract(char *description)+{+  FileOffset fo;++  fo = writeTag(AtomAbstract, 1+stringSize(description));+  writeString(description);+  HIDE(fprintf(stderr,"\tmkAbstract %s -> 0x%x\n",description,fo);)+  return fo;+}++FileOffset+mkListCons(FileOffset elem,FileOffset tail)+{+  FileOffset fo;++  fo = writeTag(ListCons,1 + 2*sizeof(FileOffset));+  writeFileOffset(elem);+  writeFileOffset(tail);+  HIDE(fprintf(stderr,"\tmkListCons 0x%x 0x%x -> 0x%x\n",elem,tail,fo);)+  return fo;+}+++/* Update node that it was entered */++void entResult(FileOffset node,FileOffset use)+{+  LastExp = node;+  node &= hiddenMask;+  HIDE(fprintf(stderr,"\tentResult 0x%x 0x%x 0x%x\n",node,use,ntohl(node)+1+sizeof(FileOffset)+(use?sizeof(FileOffset):0));)+  hat_enter(ntohl(node),1+sizeof(FileOffset)+(use?sizeof(FileOffset):0),+	    entered);+  if (controlC) +    hat_InterruptExit();+}++void entForward(FileOffset node,FileOffset hidden)+{+  hat_enter(ntohl(node),1,hidden);+  if (controlC) +    hat_InterruptExit();+}++/* Update node with result */++void resResult(FileOffset node,FileOffset result,FileOffset use)+{+  LastExp = node;+  node &= hiddenMask;+  result &= hiddenMask;+  hat_reduce(ntohl(node),1+sizeof(FileOffset)+(use?sizeof(FileOffset):0),+	     result);+}++void resForward(FileOffset node,FileOffset result)+{+  result &= hiddenMask;+  hat_reduce(ntohl(node),1,result);+}++/* Data structures and functions for various buffers.+ * All sequential writes are buffered in buffers, which consists of+ * WriteBufferNo buffers of size WriteBufferSize.+ * If updates effect data still in buffers, they are+ * made there (the majority, this it the purpose buffers);+ * the remaining ones are buffered in buffer of size BufferSize.+ * Information about entered redexes is put on the stack `stack',+ * which can grow and shrink in units of StackpartSize. Only when+ * stack elements are popped, updates are made.+ * The stack both avoids updates and enables locating an error position.+ *+ * Most FileOffsets are stored in network byte order, but some in host+ * byte order.+ */++/* Put enter updates on a stack. A reduce update pops an enter update from+ * the stack. To reduce number of seeks the reduce updates are buffered.+ * The stack is unbounded, it grows in parallel with the runtime stack.+ * An exception releases large parts of the stack. Notice this situation+ * by always comparing the at-positions of the reduce update with the+ * at-position of enter updates on the stack.+ * The stack is only written to the trace if the computation is aborted.+ */++typedef struct update {+  FileOffset at;+  FileOffset new;+} Update;++typedef struct entry {+  FileOffset at;+  FileOffset offset;+  FileOffset parent; /* or entered for anything but Forward */+} Entry;++#define StackpartSize 8000++typedef struct stackpart {+  struct stackpart *previous;+  Entry entry[StackpartSize];+} Stackpart;++static Stackpart *stack = NULL ;+static int stacktop = StackpartSize; +  /* next free entry, initialisation important */+++void hat_pushStack(FileOffset at, FileOffset offset, FileOffset new)+{+  if (stacktop >= StackpartSize) {+    Stackpart *newStackpart;+    newStackpart = malloc(sizeof(Stackpart));+    if (newStackpart == NULL) {+      fprintf(stderr,"No space for Hat stack.");+      exit (-1);+    }+    (*newStackpart).previous = stack;+    stack = newStackpart;+    stacktop = 0;+  }+  (*stack).entry[stacktop].at = at;+  (*stack).entry[stacktop].offset = offset;+  (*stack).entry[stacktop].parent = new;+  ++stacktop;+}++/* Returns at-position from top of stack; + * if top of stack is a Forward, then returns its parent;+ * result in network byte order; assumes stack != NULL; stack unchanged + */+FileOffset hat_topStack()+{+  int curStacktop = stacktop;+  Stackpart *curStack = stack;++  --curStacktop;+  if (curStacktop < 0) {+    curStack = (*curStack).previous; +    curStacktop = StackpartSize-1;+    if (curStack == NULL) +      return 0;+  }+  if ((*curStack).entry[curStacktop].offset == 1) /* is Forward */+    return (((*curStack).entry[curStacktop].parent)&hiddenMask);+  else+    return (htonl ((*curStack).entry[curStacktop].at));+}++/* returns at-position in host byte order; assumes stack != NULL */+FileOffset hat_popStack()+{+  if (stacktop == 0) {+    Stackpart *oldstack;+    oldstack = stack;+    stack = (*oldstack).previous;+    free(oldstack);+    stacktop = StackpartSize;+    if (stack == NULL) {+      fprintf(stderr,"Pop empty Hat stack.");+      exit (-1);+    }+  }+   --stacktop;+  return ((*stack).entry[stacktop].at);+}+++/* writes top of stack to trace until at position equal given one */+void hat_writeStackUntil(FileOffset at)+{+  while (True) {+    FileOffset thisAt = hat_popStack();+    if (thisAt == at) +      break;+    updateFileOffset(thisAt+(*stack).entry[stacktop].offset+                    ,((*stack).entry[stacktop].parent)&hiddenMask);+  }+}++/* Afterwards stack is unusable and even memory is not freed. */+void hat_dumpStack() {+  int i;++  while (stack != NULL) {+    for (i=0;i<stacktop;i++) {+      updateFileOffset((*stack).entry[i].at+(*stack).entry[i].offset+                      ,((*stack).entry[i].parent)&hiddenMask);+    }+    stacktop = StackpartSize;+    stack = (*stack).previous;+  }+}++/* Buffer for deferred updates */++#define BufferSize 4000+static Update buffer[BufferSize];+static int buffertop = 0;  /* next free one */++void hat_putInBuffer(FileOffset at, FileOffset new) {+  if (buffertop >= BufferSize) +    hat_dumpBuffer();+  buffer[buffertop].at = at;+  buffer[buffertop].new = new;+  ++buffertop;+}++void hat_dumpBuffer() {++  int i;++  for (i=0;i<buffertop;i++) {+    fseek(HatFile,buffer[i].at,SEEK_SET);+    fwrite(&(buffer[i].new),sizeof(FileOffset),1,HatFile);+  }+  buffertop = 0;++  fseek(HatFile,0,SEEK_END);+}++void hat_enter(FileOffset at, FileOffset offset, FileOffset entry)+{+  hat_pushStack(at,offset,entry);+}++void hat_reduce(FileOffset at, FileOffset offset, FileOffset entry)+{+  hat_writeStackUntil(at);+  updateFileOffset(at+offset,entry);+}+++/* Buffering scheme for sequential writing with updates */++#define WriteBufferNo 4  /* minimum: 1 */+#define WriteBufferSize 40000  /* minimum: size of largest node */++typedef struct writeBuffer {+  FileOffset begin;  /* in host byte order */+  int pos;+  byte content[WriteBufferSize];+} WriteBuffer;++WriteBuffer buffers[WriteBufferNo];+WriteBuffer *currentWriteBuffer = buffers;+int currentWriteBufferNo = 0;++static void +initBuffers() +{+  int i;++  for (i=0;i<WriteBufferNo;i++) {+    buffers[i].begin = 0;+    buffers[i].pos = 0;+  }+  currentWriteBuffer->begin = HeaderSize;+}++/* returns offset of newly started node in network byte order */+static FileOffset +writeTag (int tag, int size) +{+  FileOffset currentOffset;++  if (currentWriteBuffer->pos + size > WriteBufferSize) {+    currentOffset = currentWriteBuffer->begin + currentWriteBuffer->pos;+    currentWriteBufferNo = (currentWriteBufferNo+1) % WriteBufferNo;+    currentWriteBuffer = &(buffers[currentWriteBufferNo]);+    fwrite(currentWriteBuffer->content,sizeof(byte),currentWriteBuffer->pos+          ,HatFile);+    currentWriteBuffer->begin = currentOffset;+    currentWriteBuffer->pos = 0;+  }+  currentWriteBuffer->content[currentWriteBuffer->pos++] = tag;+  return (htonl(currentWriteBuffer->begin + currentWriteBuffer->pos - 1));+}++static void +writeByte (int byte)+{+  currentWriteBuffer->content[currentWriteBuffer->pos++] = byte;+}++static void +writeFileOffset (FileOffset offset) +{+  offset &= hiddenMask;+  memcpy(&(currentWriteBuffer->content[currentWriteBuffer->pos])+        ,&offset,sizeof(FileOffset));+  currentWriteBuffer->pos += sizeof(FileOffset);+}++static void +writeInt (int number) +{+  number = htonl(number);+  memcpy(&(currentWriteBuffer->content[currentWriteBuffer->pos])+        ,&number,sizeof(int));+  currentWriteBuffer->pos += sizeof(int);+}++static void +writeFloat (float number) +{+  memcpy(&(currentWriteBuffer->content[currentWriteBuffer->pos])+        ,&number,sizeof(float));+  currentWriteBuffer->pos += sizeof(float);+}++static void +writeDouble (double number) +{+  memcpy(&(currentWriteBuffer->content[currentWriteBuffer->pos])+        ,&number,sizeof(double));+  currentWriteBuffer->pos += sizeof(double);+}++static void +updateFileOffset (FileOffset at, FileOffset entry) +{+  int i;++  if (buffers[(currentWriteBufferNo+1) % WriteBufferNo].begin > at) {+    hat_putInBuffer(at,entry);+  } else {+    for (i=0;i<WriteBufferNo;i++) {+      if (at >= buffers[i].begin && at < buffers[i].begin + buffers[i].pos) {+        memcpy(&(buffers[i].content[at - buffers[i].begin])+              ,&entry,sizeof(FileOffset));+        break;+      }+    } +  }+}++/* size of string when stored in hat file (including length information) */+static int+stringSize(char *s)+{+  int length = strlen(s);+  if (length < 255)+    return (length+1);+  else+    return (length+3);+}++static void+writeString(char *s)+{+  int length = strlen(s);+  if (length < 255)+    writeByte(length);+  else {+    writeByte(255);+    writeByte(length>>8); /* high byte first */+    writeByte(length);+  }+  memcpy(&(currentWriteBuffer->content[currentWriteBuffer->pos]),s,length);+  currentWriteBuffer->pos += length;+}++static void+dumpBuffers()+{+  int i;+  fseek(HatFile,0,SEEK_END);+  for (i=0;i<WriteBufferNo;i++) {+    currentWriteBufferNo = (currentWriteBufferNo + 1) % WriteBufferNo;+    fwrite(buffers[currentWriteBufferNo].content,sizeof(byte)+          ,buffers[currentWriteBufferNo].pos,HatFile);+  }+}+++/* Store children of Hidden nodes in linked list of ListCons nodes + * The child pointer of every Hidden node unequal NULL is kept in + * a HiddenChildren buffer. That buffer is written at the end.+ * The buffer serves both for *reading* the current and writing a + * new child pointer.+ * This avoids having to read the trace; the assumption is that+ * there are few Hidden nodes with children, hence the buffer is small.+ */++typedef struct hcEntry {+  FileOffset at;+  FileOffset child;+} HCEntry;++#define HCPartSize 8000++typedef struct hcPart {+  HCEntry entry[HCPartSize];+  struct hcPart *previous;+  int top;+} HCPart;+++static HCPart *hiddenChildrenSet = NULL ;++static void initHiddenChildrenSet()+{+  hiddenChildrenSet = malloc(sizeof(HCPart));+  if (hiddenChildrenSet == NULL) {+    fprintf(stderr,"No space for Hat Children set.");+    exit (-1);+  }+  hiddenChildrenSet->top = 0;+  hiddenChildrenSet->previous = NULL;+}++/* Can be invoked any time. The hiddenChildrenSet data structure keeps alive. */+static void dumpHiddenChildrenSet() +{+  int i;+  HCPart *curHC = hiddenChildrenSet;+  +  while (curHC != NULL) {+    for (i=0;i<curHC->top;i++) {+      updateFileOffset(curHC->entry[i].at,curHC->entry[i].child);+    }+    curHC = curHC->previous;+  }+}++void recordChild(FileOffset hidden,FileOffset child)+{+  /* basically: read child pointer of Hidden node, write ListCons with+   * child and read old child pointer, overwrite child pointer of Hidden+   * node.+   * The difficulty is that the child pointer is (hopefully) in one of+   * several buffers, avoiding file read and write access.+   */+  FileOffset listTail,newCons;+  int i;+  HCPart *curHC;+  FileOffset at = ntohl(hidden&hiddenMask) + 1 + 2*sizeof(FileOffset);++  for (curHC = hiddenChildrenSet; curHC != NULL; curHC = curHC->previous)+    for (i = 0; i<curHC->top;i++)+      if (curHC->entry[i].at == at)+        goto found;++  /* not found in set, need to add an entry */++  if (hiddenChildrenSet->top<HCPartSize) {+    /* add in first part */+    curHC = hiddenChildrenSet;+    i = curHC->top++;+  } else {+    /* add another part at front */+    curHC = malloc(sizeof(HCPart));+    if (curHC == NULL) {+      fprintf(stderr,"No space for Hat Children set.");+      exit (-1);+    }+    curHC->previous = hiddenChildrenSet; +    hiddenChildrenSet = curHC;+    curHC->top = 1;+    i = 0;+  }+  curHC->entry[i].at = at;+  curHC->entry[i].child = LISTEND;++ found:++  /* read current child tail of Hidden node */+  listTail = curHC->entry[i].child;+ +  /* create extended children list */+  newCons = mkListCons(child,listTail);+    +  /* overwrite child tail pointer of Hidden node */+  curHC->entry[i].child = newCons;+}+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ compiler98/AssocTree.hs view
@@ -0,0 +1,58 @@+module AssocTree+  ( AssocTree+  , Tree+  , initAT	-- :: AssocTree k v+  , listAT	-- :: AssocTree k v -> [(k,v)]+  , reorderAT	-- :: (AssocTree k v -> (j,u) -> AssocTree k v)+		--			 -> AssocTree j u -> AssocTree k v+  , addAT	-- :: Ord k =>+		--	 AssocTree k v -> (v->v->v) -> k -> v -> AssocTree k v+  , lookupAT	-- :: Ord a =>+		--	 AssocTree k v -> k -> Maybe v+  , updateAT 	-- :: Ord k =>+		--	 AssocTree k v -> k -> (v->v) -> AssocTree k v+  , mapAT       -- :: (v -> w) -> AssocTree k v -> AssocTree k w+  ) where++import Tree234++newtype AssocTree k v = AssocTree (Tree (k,v))++instance (Show k, Show v) => Show (AssocTree k v) where+  show t = show (listAT t)++initAT :: AssocTree k v+initAT = AssocTree initTree++listAT :: AssocTree k v -> [(k,v)]+listAT (AssocTree t) = treeMapList (:) t++reorderAT :: (AssocTree k v -> (j,u) -> AssocTree k v)+	 -> AssocTree j u -> AssocTree k v+reorderAT translate t = +   foldl translate initAT (listAT t) ++cmp1 key (key',value) = compare key key'++cmp2 key _ (key',value) = compare key key'++addAT :: Ord k => AssocTree k v -> (v->v->v) -> k -> v -> AssocTree k v+addAT (AssocTree t) comb key value = +  AssocTree $ treeAdd combine (cmp2 key) (key,value) t+ where+   combine (k1,v1) (k2,v2) = (k2,comb v1 v2)++lookupAT :: Ord k => AssocTree k v -> k -> Maybe v+lookupAT (AssocTree t) key = +   treeSearch Nothing ok (cmp1 key) t+  where+   ok (key,value) = Just value++updateAT :: Ord k => AssocTree k v -> k -> (v->v) -> AssocTree k v+updateAT (AssocTree t) key upd = +  AssocTree $ treeUpdate update (cmp1 key) t+ where+   update (k1,v1) = (k1,upd v1)++mapAT :: (v -> w) -> AssocTree k v -> AssocTree k w+mapAT f (AssocTree t) = AssocTree $ treeMap (\(k, v) -> (k, f v))  t
+ compiler98/Error.hs view
@@ -0,0 +1,41 @@+module Error where++import Data.List+import System.IO+import System.Exit++exit :: IO a+exit = exitWith (ExitFailure 1)++can'tOpen :: String -> a -> IO b+can'tOpen filename ioError =+  do+    hPutStr stderr ("Can't open "++filename ++ "\n")+    exit++errorStr :: String -> String -> String+errorStr filename msg = "In file "++filename++":\n"++msg ++ "\n"++can'tOpenStr :: String -> [String] -> a -> String+can'tOpenStr name [filename] ioerror =+   "Can't open "++ filename  ++ " when trying to read "++name++".\n"+can'tOpenStr name filename ioerror =+   "Can't open any of:\n "++ concatMap (++"\n ") (nub filename)+   ++ "when trying to read "++name++".\n"++errorMsg :: String -> String -> IO a+errorMsg filename msg =+  do+    hPutStr stderr  (errorStr filename msg)+    exit++can'tOpenAnyOf :: String -> [String] -> a -> IO b+can'tOpenAnyOf name filename ioError =+  do+    hPutStr stderr (can'tOpenStr name filename ioError)+    exit++errorLC :: Int -> Int -> String -> a+errorLC  l c msg =+  error ("Error at line "++show l ++", column " ++ show c ++ ": " ++ msg++"\n")+
+ compiler98/Extra.hs view
@@ -0,0 +1,293 @@+module Extra(module Extra, module HbcOnly, module Data.Maybe, trace) where++import HbcOnly+import Data.Char+import Data.List+import Data.Maybe+import System.IO (hPutStr,stderr)+import System.Exit (exitFailure)+import SysDeps (trace)++mapListSnd :: (a -> b) -> [(c,a)] -> [(c,b)]+mapListSnd f = map (mapSnd f)++foldls f z [] = z+foldls f z (x:xs) =+  let z' = f z x+  in seq z' (foldl f z' xs)++strace msg c = if length msg == 0+	       then  c+	       else trace msg c++warning s v = trace ("Warning: "++s) v+--warning s v = v++fstOf a b = a+sndOf a b = b++snub [] = []+snub (x:xs) = x:snub (filter (/=x) xs)++pair   x y   = (x,y)+triple x y z = (x,y,z)++-- #if !defined(__HASKELL98__)+-- isNothing Nothing = True+-- isNothing _       = False+-- #endif++dropJust (Just v) = v++isLeft (Left a) = True+isLeft _        = False++isRight (Right a) = True+isRight _        = False++dropLeft (Left a) = a++dropRight (Right a) = a++dropEither (Left x) = x+dropEither (Right x) = x++mapPair f g (x,y) = (f x,g y)+mapFst  f   (x,y) = (f x,  y)+mapSnd    g (x,y) = (  x,g y)++findLeft l = +        f [] l+    where+        f a [] = Right (reverse a)+        f a (Left  e:r) = Left e+        f a (Right x:r) = f (x:a) r++eitherMap f [] = Right []+eitherMap f (x:xs) =+        case f x of+          Left err -> Left err+          Right x' -> case eitherMap f xs of+                        Left err -> Left err+                        Right xs' -> Right (x':xs') +++jRight :: Int -> [Char] -> [Char]+jRight n s = case length s of+                ns -> if ns > n then s+                      else space (n-ns) ++ s++jLeft :: Int -> [Char] -> [Char]+jLeft n s = case length s of+                ns -> if ns > n then s+                      else s ++ space (n-ns)++partitions f [] = []+partitions f (x:xs) =+    gB f (f x) [x] xs+  where+    gB f v a [] = [reverse a]+    gB f v a (x:xs) = if f x == v+                      then gB f v (x:a) xs+                      else reverse a : gB f (f x) [x] xs++----------++mix s [] = ""+mix s xs =  foldl1 (\x y-> x ++ s ++ y) xs++mixSpace = mix " "+mixComma = mix ","+mixLine  = mix "\n"++mixCommaAnd [x] = x+mixCommaAnd [x,y] = x ++ " and " ++ y+mixCommaAnd (x:xs) = x ++ ", " ++ mixCommaAnd xs++rep 0 c = []+rep n c = c:rep (n-1) c++-----------------++assoc :: Eq a => a -> [(a,b)] -> b+assoc a [] = error "assoc!"+assoc a ((k,v):kvs) = if a == k then v+                       else assoc a kvs++assocDef :: Eq a => [(a,b)] -> b -> a -> b+assocDef []          d a = d+assocDef ((k,v):kvs) d a = if a == k then v+                           else assocDef kvs d a++-------------------++-- abstract type for storing the position of a syntactic construct in a file,+-- that is, line and column number of both start and end positions.++data Pos = P !Int !Int+-- line * 10000 + column of start, line * 10000 + column of end+-- both lines and column start at 1+-- allow lines and coluns 0 to mark nonexisting position++type Line = Int+type Column = Int++-- used in STGcode to get encoded start position+-- STGcode should be changed so that this function can disappear+pos2Int :: Pos -> Int +pos2Int (P s _) = s++toPos :: Line -> Column -> Line -> Column -> Pos+toPos l1 c1 l2 c2 =  P (l1*10000 + c1) (l2*10000 + c2) ++-- create a virtual position out of a real one+insertPos :: Pos -> Pos+insertPos (P s e) = P s 0++noPos :: Pos+noPos = P 0 0++mergePos :: Pos -> Pos -> Pos+-- combines positions by determining minimal one that covers both+-- positions may or may not overlap+-- does not assume that first pos really earlier +-- nonexisting positions are ignored+mergePos (P s1 e1) (P s2 e2) =+  if e1 == 0 then P s2 e2+  else if e2 == 0 then P s1 e1+  else P (min s1 s2) (max e1 e2)++mergePoss :: [Pos] -> Pos+-- merge a list of positions+mergePoss = foldr mergePos noPos++fromPos :: Pos -> (Line,Column,Line,Column)+fromPos (P s e) =+ let l1 = s `div` 10000+     c1 = s - l1*10000+     l2 = e `div` 10000+     c2 = e - l2*10000+ in (l1,c1,l2,c2)++strPos :: Pos -> String+strPos p = +  case fromPos p of+    (0,0,0,0) -> "nopos"+    (l1,c1,0,0)   -> show l1 ++ ':' : show c1+    (l1,c1,l2,c2) | l1==l2 && c1==c2+                  -> show l1 ++ ':' : show c1+    (l1,c1,l2,c2) -> show l1 ++ ':' : show c1 ++ '-' : show l2 ++ ':' : show c2++instance Show Pos where+  show p = strPos p++instance Eq Pos where+  P s1 e1 == P s2 e2 = (s1 == s2) && (e1 == e2)++instance Ord Pos where  +  -- for ordering error messages of parser+  -- and determining minimum of two positions+  -- nonexisting positions are avoided+  P s1 e1 > P s2 e2 = +    s1 > s2 || (s1 == s2 && e1 > e2)+  min (P s1 e1) (P s2 e2) =+    if e1 == 0 +      then if e2 == 0 +             then if s1 <= s2 then P s1 e1 else P s2 e2+             else P s2 e2+      else if e2 == 0+             then P s1 e1+             else if (s1 < s2) || (s1 == s2 && e1 <= e2)+                    then P s1 e1+                    else P s2 e2 ++--------------------+++data SplitIntegral = SplitPos [Int]+                   | SplitZero+                   | SplitNeg [Int]++-- splitIntegral :: (Integral a) => a -> SplitIntegral+splitIntegral n =+  if n < 0+  then SplitNeg (split' (-n))+  else if n == 0 then SplitZero+  else SplitPos (split' n)+ where+  split' n = if n == 0 then []+             else fromInteger (toInteger (n `mod` 256)) : split' (n `div` 256)++--------------------+type Set a = [a]++emptySet = []++singletonSet a = [a]++listSet xs = (nub xs)++unionSet xs ys = unionSet' xs ys+               where unionSet' [] ys = ys+                     unionSet' (x:xs) ys | x `elem` ys = unionSet' xs ys+                                         | otherwise   = x:unionSet' xs ys++removeSet xs ys = filter (`notElem` ys) xs+---------------------+strChr' :: Char -> Char -> String +strChr' del '\\' = "\\\\"+strChr' del '\n' = "\\n"+strChr' del '\t' = "\\t"+strChr' del c = if isPrint c +                 then if c == del +                      then "\\" ++ [c]+                      else [c]+                 else "\\o" ++ map (toEnum . (+(fromEnum '0')))+                                  (ctoo (fromEnum c))+                    where ctoo c = [(c `div` 64),(c `div` 8) `mod` 8,c `mod` 8]+                          +strChr :: Char -> String +strChr c = "'" ++ strChr' '\'' c ++ "'"++strStr :: String -> String +strStr s = "\"" ++ concatMap (strChr' '"') s ++ "\""++-----------------------+showErr :: (Pos,String,[String]) -> String+showErr (pos,token,strs) =+    strPos pos ++ (" Found " ++ token +++    case nub strs of+           [] -> " but no token can be accepted here."+           [x] -> " but expected a " ++ x+	   xs  -> " but expected one of " ++ mix " " xs)++------------------------+isNhcOp :: Char -> Bool+isNhcOp '~' = True; isNhcOp '=' = True; isNhcOp '*' = True+isNhcOp '%' = True; isNhcOp '/' = True; isNhcOp ':' = True+isNhcOp '+' = True; isNhcOp '@' = True; isNhcOp '.' = True+isNhcOp '>' = True; isNhcOp '&' = True; isNhcOp '$' = True+isNhcOp '|' = True; isNhcOp '-' = True+isNhcOp '!' = True; isNhcOp '<' = True+isNhcOp '^' = True; isNhcOp '#' = True; isNhcOp '?' = True+isNhcOp '\\' = True+isNhcOp _ = False++------------------------+-- Given a list of filenames, return filename and its content of first file+-- that was read successfully (intention: other filenames may not exist)++readFirst :: [String] -> IO (String,String)++readFirst []     = do+  hPutStr stderr "Fail no filenames, probably no -I or -P" +  exitFailure+readFirst [x]    = do +  finput <- readFile x+  return (x,finput)+readFirst (x:xs) =+  catch (do finput <- readFile x+            return (x,finput))+        (\ _ -> readFirst xs)++------------------------
+ compiler98/HbcOnly.hs view
@@ -0,0 +1,12 @@+module HbcOnly where++space :: Int -> String+space n = if n == 0 then ""+          else ' ':space (n-1)++fst3 (a,_,_) = a+snd3 (_,a,_) = a+thd3 (_,_,a) = a++makeDouble :: Integer -> Double -> Int -> Double+makeDouble i f e = (fromIntegral i +f) * (10.0 ^^ e)
+ compiler98/Id.hs view
@@ -0,0 +1,12 @@+{- ---------------------------------------------------------------------------+This is the start for an abstract data type Id.+We need instance Eq Id and instance Ord Id.+Furthermore an IdSupply.+However, currently Int is used for that purpose and shall slowly be+replaced by the new type Id.+-}+module Id(Id) where++type Id = Int++{- End Module Id ------------------------------------------------------------}
+ compiler98/IdKind.hs view
@@ -0,0 +1,60 @@+{- ---------------------------------------------------------------------------+Defines data type IdKind which tells of which kind an identifier is, +e.g. a module identifier or a class identifier+-}++module IdKind(IdKind(..)) where++data IdKind = Var+            | Arg+            | Method+            | TVar+            | Con+            | TCon+            | TSyn+            | TClass+            | TC+            | Modid+            | MethodInstance+            | MethodDefault+	    | Field++ordIdKind :: IdKind -> Int+ordIdKind  Var    =  1+ordIdKind  Arg    =  1+ordIdKind  Method =  1+ordIdKind  TVar   =  2+ordIdKind  Con    =  3+ordIdKind  TCon   =  4+ordIdKind  TSyn   =  4+ordIdKind  TClass =  4+ordIdKind  TC     =  4+ordIdKind  Modid  =  5+ordIdKind  MethodInstance =  6+ordIdKind  MethodDefault  = 7+ordIdKind  Field =   8++instance Eq IdKind where+         a      == b      = ordIdKind a == ordIdKind b++instance Ord IdKind where+         a  <= b = ordIdKind a <= ordIdKind b+         a  <  b = ordIdKind a <  ordIdKind b+         compare a  b = compare (ordIdKind a) (ordIdKind b)+++instance Show IdKind where+  showsPrec d Var    = ("Identifier"++)+  showsPrec d Arg    = ("Argument"++)+  showsPrec d Method = ("Method"++)+  showsPrec d TVar   = ("Typevar"++)+  showsPrec d Con    = ("Constructor"++)+  showsPrec d TC     = ("Type constructor/class"++)+  showsPrec d TCon   = ("Type constructor"++)+  showsPrec d TSyn   = ("Type synonym"++)+  showsPrec d TClass = ("Type class"++)+  showsPrec d Modid  = ("Module identifier"++)+  showsPrec d MethodDefault  = ("Default method"++)+  showsPrec d MethodInstance = ("Instance method"++)+  showsPrec d Field = ("Field"++)+
+ compiler98/Info.hs view
@@ -0,0 +1,498 @@+{- ---------------------------------------------------------------------------+Central data structures of the symbol table+-}+module Info(module Info, IdKind,TokenId,NewType,InfixClass(..),Pos+           ,AssocTree,Tree) where++import IdKind(IdKind)+import TokenId(TokenId)+import NT+import Extra(Pos,sndOf,strace)+import SysDeps(PackedString)+import AssocTree+import Syntax(InfixClass(..))+import Id(Id)++data IE = IEnone | IEsel | IEsome | IEabs | IEall deriving (Eq,Show) +-- This is "Interface Exports"+--    defined in a lattice   IEall+--                          /     \+--                         |     IEsome+--                       IEsel     |+--                         |     IEabs+--                          \     /+--                           IEnone+--   IEall  -> exported (with all constructors/fields/methods)+--   IEsome -> exported with selected constructors/fields/methods+--   IEabs  -> exported abstractly (without constructors/fields/methods)+--   IEnone -> not exported+--   IEsel  -> selected constructors/fields/methods+--			 (is exported, despite defn below!)++isExported IEnone = False+isExported IEsel  = False+isExported _      = True++combIE IEall  _     = IEall+combIE _      IEall = IEall+combIE IEnone i     = i+combIE i     IEnone = i+combIE IEsome IEabs = IEsome+combIE IEabs IEsome = IEsome+combIE _      i     = i++-- Patch newtype for exports  (Its constructor must always be in the+-- interface file, even if not visible in the importing module.)+patchIE IEabs = IEsome+patchIE ie    = ie++data DataKind = +    DataTypeSynonym Bool  -- True <-> unboxed after expansion+                    Int   -- depth (used to determine +                          -- which type synonym to expand)+  | DataNewType	    Bool  -- always False+                    [Id]  -- constructor(one or zero) +  | Data 	    Bool  -- True <-> unboxed+                    [Id]  -- constructors+  | DataPrimitive   Int	  -- size+  deriving (Show)++data Info =+    InfoClear   -- used to remove imported when redefining in mutally +                -- recursive modules and when compiling the prelude+  | InfoUsed      Id       -- unique+                  [(IdKind,TokenId,PackedString,Pos)] -- occurrence where used+  | InfoUsedClass Id       -- unique+                  [(IdKind,TokenId,PackedString,Pos)] -- occurrence where used+                  (AssocTree Int ([Int],[(Int,Int)]))  +                  -- instances of the class+                  -- the tree associates a type constructor with+                  -- the free variables and the superclass context +                  -- of an instance+  | InfoData      -- data type (algebraic, type synonym, ...)+                  Id       -- unique+                  TokenId  -- token of data type name+                  IE       -- is exported?+                  NewType  -- if type synonym: type it is defined to be+                           -- if data or newtype: defined type+                           -- e.g.: data Num a => Test a b = A a | B b+                           -- NewType [1,2] [] [(NumId, 1)] +                           --   [NTvar 1 Star, NTvar 2 Star, mkNTcons TestId +                           --                     [NTvar 1 Star, NTvar 2 Star]]+                  DataKind -- kind of data type +  | InfoClass     Int      -- unique+                  TokenId  -- token of class name+                  IE       -- is exported?+                  NewType  -- pseudo type built from class and type variable+                           -- (type of dictionary?)+                  [Id]     -- method ids refering to type declaration+                  [Id]     -- method ids refering to default definition+                           -- ids in same position refer to same method+                           -- => lists have same lengths+                  (AssocTree Int ([Int],[(Int,Int)]))    +                  -- instances of the class+                  -- the tree associates a type constructor with+                  -- the free variables and the superclass context +                  -- of an instance+  | InfoVar       -- term variable +                  Int          -- unique +                  TokenId      -- token for name+                  IE           -- is exported?+                  (InfixClass TokenId,Int)  -- fixity +                  NewType      -- type+                  (Maybe Int)  -- arity (if available)+  | InfoConstr    -- data constructor+                  Int          -- unique +                  TokenId      -- token for name+                  IE           -- is exported?+                  (InfixClass TokenId,Int)  -- fixity +                  NewType      -- type of the constructor+                  [Maybe Int]  -- field names (if they exist) +                  Int          -- data type to which constructor belongs+  | InfoField     -- field name+                  Id           -- unique+                  TokenId      -- token for name+                  IE           -- is exported?+                  [(Id,Int)]   -- [(data constructor, offset for this constr.)]+                  Id           -- iData+                  Id           -- iSel	+                  -- unique tid [(constructor,offset)] type selector+  | InfoMethod    -- for type declaration of method in a class definition+                  Id           -- unique +                  TokenId      -- token for method name+                  IE           -- is exported?+                  (InfixClass TokenId,Int) -- fixity+                  NewType +                  (Maybe Int)  -- arity (if available; here bogus)+                  Id           -- unique of class to which method belongs+  | InfoIMethod   -- for definition in instance definition+                  Id           -- unique +                  TokenId      -- token for name+                  NewType +                  (Maybe Int)  -- arity (if available) +                  Id           -- iMethod (0 after renaming)+                  -- The type is NewType free instancs_ctx instance_type, +                  -- for real type follow iMethod+  | InfoDMethod   -- for default definition in class definition+                  Id           -- unique+                  TokenId      -- token for method name+                  NewType +                  (Maybe Int)  -- arity (if available) +                  Id           -- class to which method belongs+  | InfoInstance  -- Only used in Export+                  Id           -- unique+                  NewType +                  Id 	       -- unique of class (of which this is instance)+  | InfoName      Id           -- unique+                  TokenId      -- token for name+                  Int          -- arity+                  TokenId      +                  Bool         --PHtprof indicates subfn+    -- inserted late to hold name and arity for some functions +    -- (second TokenId is profname )+  deriving (Show)++{- Template+z (InfoUsed   unique uses) =+z (InfoUsedClass unique uses insts) =+z (InfoData   unique tid ie nt dk) =+      case dk of+	(DataTypeSynonym unboxed depth) ->+	(DataNewType unboxed constructors) ->+	(Data unboxed  constrs) ->+	(DataPrimitive size) ->+z (InfoClass  unique tid ie nt ms ds insts) = +z (InfoVar    unique tid ie fix nt annot) = +z (InfoConstr unique tid ie fix nt fields iType) =+z (InfoField  unique tid ie icon_offs iData iSel) =+z (InfoMethod unique tid ie fix nt annot iClass) =+z (InfoIMethod unique tid nt annot iMethod) =+z (InfoDMethod unique tid nt annot iClass) =+z (InfoInstance unique  nt iClass) =+z (InfoName pos unique tid Int ptid subfn) =  --PHtprof+-}++clearI :: a -> Info+clearI _ = InfoClear+++--isClear InfoClear = True+--isClear _ = False++isMethod :: Info -> Bool+isMethod (InfoMethod unique tid ie fix nt annot iClass) = True+isMethod _ = False+++isData :: Info -> Bool +isData (InfoData   unique tid exp nt dk) = True+isData _ = False+++isRealData :: Info -> Bool+isRealData (InfoData   unique tid exp nt dk) =+      case dk of+	(DataTypeSynonym unboxed depth) -> False+	(DataNewType unboxed constructors) -> False+	(DataPrimitive size) -> True+	(Data unboxed  constrs) -> True+isRealData info = error ("isRealData " ++ show info)+++isRenamingFor :: AssocTree Int Info -> Info -> NewType+isRenamingFor st (InfoData  unique tid exp nt (DataTypeSynonym _ depth)) = nt+isRenamingFor st info@(InfoData  unique tid exp nt (DataNewType _ constrs)) =+    case constrs of+      []  -> error ("Problem with type of a foreign imported function:\n"+                    ++"Cannot find constructor for newtype: "++show info)+      [c] -> case lookupAT st c of+               Just i  -> ntI i+               Nothing -> error ("Cannot find info for newtype constructor: "+                                 ++show info)+isRenamingFor st info = error ("isRenamingFor " ++ show info)+++isDataUnBoxed :: Info -> Bool  +isDataUnBoxed (InfoData unique tid exp nt dk) =+      case dk of+	(DataTypeSynonym unboxed depth) -> unboxed+	(DataNewType unboxed constructors) -> unboxed+	(Data unboxed  constrs) -> unboxed+	(DataPrimitive size) -> True+isDataUnBoxed info = error ("isDataUnBoxed: " ++ show info)+++isField :: Info -> Bool+isField (InfoField _ _ _ _ _ _) = True+isField _ = False++isClass :: Info -> Bool+isClass (InfoClass _ _ _ _ _ _ _) = True+isClass _ = False++isUsedClass :: Info -> Bool+isUsedClass (InfoUsedClass _ _ _) = True+isUsedClass _ = False+++depthI :: Info -> Maybe Int+depthI (InfoData unique tid exp nt dk) =+    case dk of+	(DataTypeSynonym unboxed depth) -> Just depth+	_ -> Nothing+depthI _ = Nothing+++typeSynonymBodyI :: Info -> Maybe NewType+typeSynonymBodyI (InfoData _ _ _ nt (DataTypeSynonym _ _)) = Just nt+typeSynonymBodyI _ = Nothing+++updTypeSynonym :: Bool -> Int -> Info -> Info+updTypeSynonym unboxed depth (InfoData unique tid exp nt dk) =+      case dk of+	(DataTypeSynonym _ _) ->+	  (InfoData unique tid exp nt (DataTypeSynonym unboxed depth)) +++{-+-- Sets the unboxedness information in newtype info as given.+-}+updNewType :: Bool -> Info -> Info+updNewType unboxed (InfoData unique tid exp nt dk) =+      case dk of+	(DataNewType _ constructors) -> +          InfoData unique tid exp nt (DataNewType unboxed constructors)++{-+-- Sets the type information in variable info as given.+-- Is only applied to identifiers without types,i.e. never methods of any kind!+-}+newNT :: NewType -> Info -> Info+newNT nt (InfoVar unique tid ie fix _ annot) =+          InfoVar unique tid ie fix nt annot+++ntI :: Info -> NewType+ntI (InfoData     unique tid ie nt dk)               = nt+-- ntI (InfoClass unique tid ie nt ms ds)            = nt   --- Not needed?+ntI (InfoVar      unique tid ie fix nt annot)        = nt+ntI (InfoConstr   unique tid ie fix nt fields iType) = nt+ntI (InfoMethod   unique tid ie fix nt annot iClass) = nt+ntI (InfoIMethod  unique tid nt annot iMethod)       = nt  -- Work here?+ntI (InfoDMethod  unique tid nt annot iClass)        = nt+++strictI :: Info -> [Bool]+strictI (InfoConstr _ _ _ _ (NewType free [] ctx nts) _ _) = +    map strictNT (init nts)+strictI _ = []+  -- Not strict in any argument so it doesn't matter if we return empty list++qDefI (InfoUsed _ _) = False+qDefI (InfoUsedClass _ _ _) = False+qDefI _ = True++uniqueI (InfoUsed   unique _)             = unique+uniqueI (InfoUsedClass unique _ _)        = unique+uniqueI (InfoData   unique tid ie nt dk)  = unique+uniqueI (InfoClass  unique _ _ _ _ _ _)   = unique+uniqueI (InfoVar     unique _ _ _ _ _)    = unique+uniqueI (InfoConstr  unique _ _ _ _ _ _)  = unique+uniqueI (InfoField   unique _ _ _ _ _)    = unique+uniqueI (InfoMethod  unique _ _ _ _ _ _)  = unique+uniqueI (InfoIMethod  unique _ _ _ _)     = unique+uniqueI (InfoDMethod  unique _ _ _ _)     = unique+uniqueI (InfoInstance unique _ _)         = unique+uniqueI (InfoName  unique _ _ _ _)        = unique --PHtprof+++tidI :: Info -> TokenId+tidI (InfoData   unique tid exp nt dk) = tid+tidI (InfoClass  u tid _ _ _ _ _)      = tid+tidI (InfoVar     u tid _ _ _ _)       = tid+tidI (InfoConstr  u tid _ _ _ _ _)     = tid+tidI (InfoField   u tid _ _ _ _)       = tid+tidI (InfoMethod  u tid _ _ _ _ _)     = tid+tidI (InfoIMethod  u tid _ _ _)        = tid+tidI (InfoDMethod  u tid _ _ _)        = tid+tidI (InfoName  u tid _ _ _)           = tid --PHtprof+tidI (InfoUsedClass u ((_,tid,_,_):_) _) = tid	--MW+tidI info = error ("tidI (Info.hs) called with bad info:\n" ++ show info)+++cmpTid :: TokenId -> Info -> Bool+cmpTid t (InfoUsed _ _)        = False+cmpTid t (InfoUsedClass _ _ _) = False+cmpTid t i                     = tidI i == t+++methodsI :: Info -> [(Int,Int)]+methodsI (InfoClass u tid ie nt ms ds inst) = zip ms ds+++instancesI :: Info -> AssocTree Int ([Int],[(Int,Int)])+instancesI (InfoClass u tid e nt ms ds inst) = inst+instancesI info@(InfoUsedClass u uses inst) = +  strace ("***instanceI(1) "++show info++"\n") inst+instancesI info = +  strace ("***instanceI(2) "++show info++"\n") initAT +  -- This is a lie!!! For some reason has this class no real entry+++{- Return identifiers of all superclasses of the class which is described+-- by given info.+-}+superclassesI :: Info -> [Int]+superclassesI (InfoClass _ _ _ (NewType _ [] ctxs _) _ _ _) = map fst ctxs+superclassesI info = error ("superclassesI " ++ show info)++{- Add information about an instance to info of a class.+-- If information about this instance exists already in info, then info left+-- unchanged.+-- type constructor -> free type variables -> context -> class info+--             -> class info+-}+addInstanceI :: Int -> [Int] -> [(Int,Int)] -> Info -> Info+addInstanceI con free ctxs info@(InfoClass u tid e nt ms ds inst) =+  case lookupAT inst con of+    Just _ -> info+    Nothing -> InfoClass u tid e nt ms ds (addAT inst sndOf con (free,ctxs))+addInstanceI con free ctxs info@(InfoUsedClass u uses inst) =+  case lookupAT inst con of+    Just _ -> info+    Nothing -> InfoUsedClass u uses (addAT inst sndOf con (free,ctxs))+addInstanceI con free ctxs (InfoUsed u uses) = +	addInstanceI con free ctxs (InfoUsedClass u uses initAT)++{-+-- In joining two trees for describing instances the second one gets+-- precedence in case of conflict.+-}+joinInsts :: AssocTree Int a -> AssocTree Int a -> AssocTree Int a+joinInsts inst inst' =+  foldr (\(k,v) inst -> addAT inst sndOf k v) inst (listAT inst')+++{- Determine constructors of a type from the info of the type -}+constrsI :: Info -> [Int]+constrsI (InfoName  unique tid i ptid _) = [unique]   --PHtprof+  -- ^this is a lie! but it is consistent with belongstoI :-)+constrsI (InfoData   unique tid exp nt dk) =+      case dk of+	(DataTypeSynonym unboxed depth) ->  +           strace ("Constr of type synonym "++show tid++"\n") []+	(DataNewType unboxed constructors) -> constructors+	(DataPrimitive size) ->+           strace ("Constr of data primitive "++show tid++"\n") []+	(Data unboxed  constrs) -> constrs+constrsI info = error ("constrsI " ++ show info)+++updConstrsI :: Info -> [Int] -> Info+updConstrsI (InfoData unique tid exp nt dk) constrs' =+  case dk of+    (Data unboxed  constrs) -> +      InfoData unique tid exp nt (Data unboxed constrs')+++fieldsI (InfoConstr unique tid ie fix nt fields iType) = fields+++combInfo :: Info -> Info -> Info++combInfo  InfoClear      info'               = info'+combInfo (InfoUsed _ w) (InfoUsed u' w')     = InfoUsed u' (w++w')+combInfo (InfoUsed _ _)  info'               = info'+combInfo  info           InfoClear           = info+combInfo  info          (InfoUsed _ _)       = info+combInfo i1@(InfoUsedClass _ uses insts) +         i2@(InfoClass u tid exp nt ms ds insts') =+  InfoClass u tid exp nt ms ds (joinInsts insts' insts)+combInfo i1@(InfoClass _ tid exp nt ms ds insts) +         i2@(InfoUsedClass u uses insts') =+  InfoClass u tid exp nt ms ds (joinInsts insts' insts)+combInfo (InfoClass u tid exp nt ms ds insts) +         (InfoClass u' tid' exp' nt' [] [] insts') =	+  InfoClass u tid (combIE exp exp') nt ms ds (joinInsts insts' insts)+combInfo (InfoClass u tid exp nt ms ds insts) +         (InfoClass u' tid' exp' nt' ms' ds' insts') =	+  InfoClass u tid (combIE exp exp') nt' ms' ds' (joinInsts insts' insts)+combInfo info@(InfoData u tid exp nt dk) +         info'@(InfoData u' tid' exp' nt' dk')  =+  case dk' of+    Data unboxed [] -> info+    _ -> if isExported exp' then info' else info+combInfo info info' =  +  -- Use new (if possible) so that code can override old imported+	if isExported (expI info)+	then info+        else info'++expI (InfoData    _ _ ie _ _)      = ie+expI (InfoClass   _ _ ie _ _ _ _)  = ie+expI (InfoVar     _ _ ie _ _ _)    = ie+expI (InfoConstr  _ _ ie _ _ _ _)  = ie+expI (InfoField   _ _ ie _ _ _)    = ie  -- Data contains export info+expI (InfoMethod  _ _ ie _ _ _ _)  = ie+expI (InfoIMethod _ _ _ _ _)       = IEnone+expI (InfoDMethod _ _ _ _ _)       = IEnone+expI info                          = IEnone  -- I get InfoUsed here !!!++-- arity without context (Visible)+arityVI (InfoVar _ _ _ _ _ (Just arity))             =  arity+arityVI (InfoConstr _ _ _ _ (NewType _ _ _ nts) _ _) = length nts - 1+arityVI (InfoMethod _ _ _ _ _ (Just arity) _)        = 1+arityVI (InfoIMethod _ _ _ (Just arity) _)           = arity+arityVI (InfoDMethod _ _ _ (Just arity) _)           = arity +arityVI (InfoName _ _ arity _ _)                     = arity --PHtprof++-- arity with context+arityI (InfoVar _ _ _ _ (NewType _ _ ctx _) (Just arity))  = length ctx + arity+arityI (InfoVar _ _ _ _ _                   (Just arity))  = arity+					-- NR Generated after type deriving+arityI (InfoConstr _ _ _ _ (NewType _ _ _ nts) _ _)        = length nts - 1+arityI (InfoMethod _ _ _ _ _ (Just arity) _)               = 1+-- Wrong !!! +-- arityI  (InfoIMethod _ _ (NewType _ _ ctx _) (Just arity) _)+--                                                         = length ctx + arity+arityI (InfoDMethod  _ _  (NewType _ _ ctx _) (Just arity) _)+                                                           = length ctx + arity+                                                             + 1+					--  +1 is for the dictionary+arityI (InfoName  unique tid arity ptid _)                 = arity --PHtprof+arityI info  =  error ("arityI " ++ show info)++arityIM (InfoMethod _ _ _ _ (NewType _ _ ctx _) (Just arity) _)+                                                           = length ctx + arity++fixityI (InfoVar     unique tid ie fix nt annot)        = fix+fixityI (InfoConstr  unique tid ie fix nt fields iType) = fix+fixityI (InfoMethod  unique tid ie fix nt annot iClass) = fix+fixityI _ = (InfixDef,9::Int)+++belongstoI :: Info -> Id+belongstoI (InfoConstr  unique tid ie fix nt fields iType)  = iType+belongstoI (InfoField   unique tid ie icon_offs iData iSel) = iData+belongstoI (InfoMethod  unique tid ie fix nt annot iClass)  = iClass+belongstoI (InfoIMethod  unique tid nt annot iMethod)       = iMethod  +  -- ^Maybe ought to be it's own function+belongstoI (InfoDMethod  unique tid nt annot iClass)        = iClass+belongstoI (InfoInstance unique  nt iClass)                 = iClass+belongstoI (InfoName  unique tid i ptid _)                  = unique  --PHtprof+  -- ^this is a lie! but it is consistent with constrsI :-)+belongstoI info =  error ("belongstoI " ++ show info)+++profI :: Info -> TokenId+profI (InfoData   unique tid exp nt dk) = tid+profI (InfoClass  u tid _ _ _ _ _)      = tid+profI (InfoVar     u tid _ _ _ _)       = tid+profI (InfoConstr  u tid _ _ _ _ _)     = tid+profI (InfoField   u tid _ _ _ _)       = tid+profI (InfoMethod  u tid _ _ _ _ _)     = tid+profI (InfoIMethod  u tid _ _ _)        = tid+profI (InfoDMethod  u tid _ _ _)        = tid+profI (InfoName  u tid _ ptid _)        = ptid --PHtprof+profI info = error ("profII (Info.hs) " ++ show info)
+ compiler98/IntState.hs view
@@ -0,0 +1,266 @@+{- ---------------------------------------------------------------------------+Internal state of the compiler +used from the renaming pass until code generation+-}+module IntState(module IntState, module Info) where++import AssocTree+import NT+import TokenId(mkQual3,mkQualD,dropM)+import Extra+import SysDeps(PackedString,packString)+import Info+import MergeSort(group)+import Reduce(Reduce)+import Id(Id)+++data IntState = +      IntState+	Int				-- unique+	(Int,PackedString)		-- modid+	(AssocTree Int Info)		-- symboltable (unique int -> info)+	[String]			-- errors++dummyIntState = IntState 0 (0,packString "<Dummy>") initAT []++-- -===== State++getInfo :: Id -> a -> IntState -> (Info,IntState)++getInfo i down state@(IntState unique rps st errors) =+  case lookupAT st i of+    Just info -> (info,state)+++addDefaultMethod :: a -> (Id,Id) -> IntState -> IntState++addDefaultMethod tidcls (iMethod,iDefault) state@(IntState unique irps@(_,rps) st errors) =+  case lookupIS state iMethod of+    Just (InfoMethod u tid ie fix nt' annot iClass) ->+      IntState unique irps +        (addAT st fstOf iDefault +          (InfoDMethod  iDefault (mkQualD rps tid) nt' annot iClass)) +        errors+++getUnique :: a -> IntState -> (Id,IntState)++getUnique down state@(IntState unique rps st errors) =+  (unique,IntState (unique+1) rps st errors)+++addInstMethod :: TokenId -> TokenId -> TokenId -> NewType -> Id +              -> a -> IntState -> (Int,IntState)++addInstMethod  tidcls tidtyp tidMethod nt iMethod down state@(IntState unique rps st errors) =+  case lookupIS state iMethod of+    Just (InfoMethod u tid ie fix nt' (Just arity) iClass) -> +      (unique,IntState (unique+1) rps (addAT st (error "adding twice!") unique (InfoIMethod unique (mkQual3 tidcls tidtyp tidMethod) nt (Just arity) iMethod)) errors)++-- -====== State0++updInstMethodNT :: TokenId -> TokenId -> Int -> NewType -> Int +                -> a -> IntState -> IntState++updInstMethodNT tidcls tidtyp i nt iMethod  down state@(IntState unique rps st errors) =+  case lookupAT st iMethod of+    Just (InfoMethod _ _ _ _ _ annots _) ->+      case lookupAT st i of+	Just (InfoIMethod u tid' _ _ _) ->+	    let tid = mkQual3 tidcls tidtyp (dropM tid')+	    in IntState unique rps (addAT st fstOf i (InfoIMethod u tid nt annots iMethod)) errors+++addInstance :: Int -> Int -> [Int] -> [(Int,Int)] -> a -> IntState -> IntState++addInstance cls con free ctxs down state@(IntState unique rps st errors) =+  let st' = updateAT st cls (addInstanceI con free ctxs)+  in  IntState unique rps st' errors+++addNewLetBound :: Int -> TokenId -> a -> IntState -> IntState++addNewLetBound i tid down state =+  addIS i (InfoVar i tid IEnone (InfixDef,9) NoType Nothing) state++-- -==== Reduce++{-+Adds type of variable to symbol table of internal state.+Assumes that variable is already in symbol table.+Adds error message, if there exists already a type for the variable+in the symbol table or type is badly formed (duplicate predicates in context). +-}+updVarNT :: Pos -> Int -> NewType -> Reduce IntState IntState++updVarNT pos i nt state@(IntState unique rps st errors) =+  case lookupAT st i of+    Just (InfoVar u tid exp fix NoType annots) ->+      case checkNT pos (strIS state) nt of+        Nothing -> IntState unique rps +                     (addAT st fstOf i (InfoVar u tid exp fix nt annots)) +                     errors+	Just err -> IntState unique rps st (err :errors)+    Just (InfoVar u tid exp fix nt' annots) ->+      IntState unique rps st +        (("New type signature for " ++ show tid ++ " at " ++ strPos pos)+         : errors)+++{-+Adds arity of variable to symbol table of internal state +(any old arity is overwritten).+Assumes that variable is already in symbol table.+-}+updVarArity :: Pos -> Int -> Int -> Reduce IntState IntState++updVarArity pos i arity state@(IntState unique rps st errors) =+  case lookupAT st i of+    Just (InfoVar  u tid exp fix nt _) ->  +      -- Always update, might change arity for redefined import in Prelude+      IntState unique rps +        (addAT st fstOf i (InfoVar u tid exp fix nt (Just arity))) errors+    _ -> state   +      -- Ignore arity for methods, methods instances and methods default+++-- -==== Stand alone++{- Add new info for identifier to the symbol table -}+addIS :: Int -> Info -> IntState -> IntState++addIS u info state@(IntState unique rps st errors) =+  IntState unique rps (addAT st combInfo u info) errors+++{- Lookup identifier in symbol table -} +lookupIS :: IntState -> Id -> Maybe Info++lookupIS (IntState unique rps st errors) i = lookupAT st i+++{- Update info for identifier in symbol table -}+updateIS :: IntState -> Id -> (Info -> Info) -> IntState++updateIS (IntState unique rps st errors) i upd =+  IntState unique rps (updateAT st i upd) errors+++{- Obtain a new unique and hence also a new internal state -}+uniqueIS :: IntState -> (Id,IntState)++uniqueIS (IntState unique rps st errors) = (unique,IntState (unique+1) rps st errors)+++{- Associate new uniques with given list of entities; hence also new internal+state -}+uniqueISs :: IntState -> [a] -> ([(a,Int)],IntState)++uniqueISs (IntState unique rps st errors) l =+   (zip l [unique..],IntState (unique+(length l)) rps st errors)+++{- Give printable string for identifier -}+strIS :: IntState -> Int -> String++strIS state i =+   case lookupIS state i of+     Just info -> show (tidI info)+     Nothing -> 'v':show i+++{- Give token of identifier -}+tidIS :: IntState -> Id -> TokenId++tidIS state i =+   case lookupIS state i of+     Just info -> tidI info++getErrors :: IntState -> (IntState,[String])+getErrors (IntState unique rps st errors) = (IntState unique rps st [], errors)++getErrorsIS :: IntState -> Either [String] IntState+getErrorsIS is@(IntState unique rps st errors)+    | null errors = Right is+    | otherwise   = Left errors++addError :: IntState -> [Char] -> IntState+addError (IntState unique rps st errors) err = +  IntState unique rps st (err:errors)++getSymbolTable :: IntState -> AssocTree Int Info+getSymbolTable (IntState unique rps st errors) = st++mrpsIS (IntState unique (i,rps) st errors) = rps+miIS (IntState unique (i,rps) st errors) = i++getIndDataIS state indDataI =+  case constrsI indDataI of+    (c:_) ->   -- Can only be one constructor +      case lookupIS state c of+	(Just infoCon) ->+          case ntI infoCon of+	    (NewType ctx free [] (NTcons con _ _:_)) -> con+++globalIS :: IntState -> Id -> Bool++globalIS state i =+  case lookupIS state i of+    Nothing -> False+    Just info -> globalI info+  where+  globalI (InfoData   unique tid ie nt dk) = isExported ie+  globalI (InfoClass  unique tid ie nt ms ds insts) = isExported ie+  globalI (InfoVar     unique tid IEsel fix nt annot) = True+  globalI (InfoVar     unique tid ie fix nt annot) = isExported ie+  globalI (InfoConstr  unique tid ie fix nt fields iType) = +    globalI' (lookupIS state iType) +  globalI (InfoField   unique tid ie icon_offs iData iSel) = +    globalI' (lookupIS state iData) +  globalI (InfoMethod  unique tid ie fix nt annot iClass) = True+  globalI (InfoIMethod  unique tid nt annot iMethod) = True+  globalI (InfoDMethod  unique tid nt annot iClass) = True+  globalI (InfoName  unique tid arity ptid _) = False --PHtprof++  globalI' (Just (InfoData   unique tid IEall nt dk)) = True+  globalI' _ = False+++arityIS :: IntState -> Id -> Int+-- arity with context++arityIS state i =+  case lookupIS state i of +    Just (InfoIMethod  unique tid (NewType _ [] ctxs [NTcons tcon _ _]) (Just arity) iMethod) ->+	case lookupIS state iMethod of+	  Just (InfoMethod  unique tid ie fix (NewType _ [] ictxs _) (Just iarity) iClass) ->+	       length ictxs + iarity + (length . snd . dropJust . lookupAT ((instancesI . dropJust . lookupIS state) iClass)) tcon++--	       length ctxs + arity + (length . snd . dropJust . lookupAT ((instancesI . dropJust . lookupIS state) iClass)) tcon+--	       length ictxs + length ctxs + arity +    Just info@(InfoIMethod  unique tid _ _ iMethod) -> error ("arityIS " ++ show info)+    Just info -> arityI info+    _ -> error ("arityIS in IntState.hs couldn't find " ++ show i)+++{-+Tests if context of type has duplicate predicates.+Second argument converts class identifier to string.+*** This module not a good place for this function.+-}+checkNT :: Pos -> (Int -> String) -> NewType -> Maybe String++checkNT pos strFun (NewType free [] ctxs nts) =+  case (filter ((1/=) . length) . group) ctxs of+    [] -> Nothing+    [x] -> Just ("Multiple occurences of " ++ (strFun . fst . head) x +++                 " with identical type variable in context close to " ++ +                 strPos pos) +    xs -> Just ("Multiple occurences of " +                ++ mixCommaAnd (map (strFun . fst . head) xs) +++                " with identical type variables in context close to " ++ +                strPos pos) ++{- End Module IntState ------------------------------------------------------}
+ compiler98/Lex.hs view
@@ -0,0 +1,231 @@+module Lex(Lex(..),LexAnnot(..),TokenId) where++import Extra(strStr,strChr)+import TokenId(TokenId)+import Data.Ratio++data LexAnnot = LexArity     TokenId Int+              | LexPrimitive TokenId (String,String)  -- id (opcode,strictness)++instance Show LexAnnot where+  showsPrec d (LexArity     fun a)   = showString "{#- ARITY " . shows fun . showString " = " . shows a  . showString "#-}"+  showsPrec d (LexPrimitive fun s)   = showString "{#- PRIMITIVE ". shows fun . showString " = " . shows s  . showString "#-}"++data Lex = +      L_EOF+    | L_ERROR Char     -- illegal character+    | L_LPAR+    | L_RPAR+    | L_LANNOT+    | L_RANNOT+    | L_LCURL | L_LCURL'+    | L_RCURL | L_RCURL'+    | L_LBRACK+    | L_RBRACK+    | L_BACKTICK+    | L_COMMA+    | L_SEMI  | L_SEMI'++-- reserved ops+    | L_DotDot+    | L_ColonColon+    | L_EqualGreater+    | L_Equal+    | L_At+    | L_Lambda+    | L_Pipe+    | L_Tidle+    | L_LessMinus+    | L_MinusGreater+    | L_Underscore++    | L_AVARID TokenId+    | L_AVAROP TokenId+    | L_ACONID TokenId+    | L_ACONOP TokenId++    | L_INTEGER Integer+    | L_RATIONAL Rational+    | L_DOUBLE  Double+    | L_CHAR    Char+    | L_STRING [Char]++-- reserved words+    | L_case+    | L_class+    | L_data+    | L_default+    | L_deriving+    | L_do+    | L_else+    | L_if+    | L_import+    | L_in+    | L_infix+    | L_infixl+    | L_infixr+    | L_instance+    | L_let+    | L_module+    | L_newtype+    | L_of+    | L_then+    | L_type+    | L_where+--    | L_as+--    | L_hiding+--    | L_prefix+--    | L_primitive+--    | L_interface+--    | L_qualified+--    | L_renaming+--    | L_unboxed+--    | L_with++instance Eq Lex where+    L_EOF          == L_EOF         = True+    (L_ERROR _)    == (L_ERROR _)   = True+    L_LPAR         == L_LPAR        = True+    L_RPAR         == L_RPAR        = True+    L_LANNOT       == L_LANNOT      = True+    L_RANNOT       == L_RANNOT      = True+    L_LCURL        == L_LCURL       = True+    L_LCURL'       == L_LCURL'      = True+    L_RCURL        == L_RCURL       = True+    L_RCURL'       == L_RCURL'      = True+    L_LBRACK       == L_LBRACK      = True+    L_RBRACK       == L_RBRACK      = True++    L_BACKTICK     == L_BACKTICK     = True+    L_COMMA        == L_COMMA        = True+    L_SEMI         == L_SEMI         = True+    L_SEMI'        == L_SEMI'        = True+    L_DotDot       == L_DotDot       = True+    L_ColonColon   == L_ColonColon   = True+    L_EqualGreater == L_EqualGreater = True+    L_Equal        == L_Equal        = True+    L_At           == L_At           = True+    L_Lambda       == L_Lambda       = True+    L_Pipe         == L_Pipe         = True+    L_Tidle        == L_Tidle        = True+    L_LessMinus    == L_LessMinus    = True+    L_MinusGreater == L_MinusGreater = True+    L_Underscore   == L_Underscore   = True++    (L_AVARID a) == (L_AVARID b) = a==b+    (L_AVAROP a) == (L_AVAROP b) = a==b+    (L_ACONID a) == (L_ACONID b) = a==b+    (L_ACONOP a) == (L_ACONOP b) = a==b++    (L_INTEGER _) == (L_INTEGER _)    = True+    (L_RATIONAL _) == (L_RATIONAL _)    = True+    (L_DOUBLE _)  == (L_DOUBLE _)  = True+    (L_CHAR _)   == (L_CHAR _)   = True+    (L_STRING _) == (L_STRING _) = True++    L_case      == L_case      = True+    L_class     == L_class     = True+    L_data      == L_data      = True+    L_default   == L_default   = True+    L_deriving  == L_deriving  = True+    L_do        == L_do        = True+    L_else      == L_else      = True+    L_if        == L_if        = True+    L_import    == L_import    = True+    L_in        == L_in        = True+    L_infix     == L_infix     = True+    L_infixl    == L_infixl    = True+    L_infixr    == L_infixr    = True+    L_instance  == L_instance  = True+    L_let       == L_let       = True+    L_module    == L_module    = True+    L_newtype   == L_newtype   = True+    L_of        == L_of        = True+    L_then      == L_then      = True+    L_type      == L_type      = True+    L_where     == L_where     = True+--    L_as        == L_as        = True+--    L_hiding    == L_hiding    = True+--    L_interface == L_interface = True+--    L_prefix    == L_prefix    = True+--    L_primitive == L_primitive = True+--    L_qualified == L_qualified = True+--    L_renaming  == L_renaming  = True+--    L_unboxed   == L_unboxed   = True+--    L_with      == L_with      = True+    _           == _           = False++instance Show Lex where+	-- Note: EOF really means end-of-file, but because error messages+	--   saying "got blah but expected EOF" are less than helpful,+	--   I have changed the string for EOF to indicate the likely cause+	--   of the parse error.+  showsPrec d (L_EOF)       = showString  "{-end-of-definition-or-EOF-}"+  showsPrec d (L_ERROR c)   = showString  "{-ERROR " . showChar c . showString "-}"+  showsPrec d (L_LPAR )     = showString  "("+  showsPrec d (L_RPAR )     = showString  ")"+  showsPrec d (L_LANNOT )   = showString  "{-#"+  showsPrec d (L_RANNOT )   = showString  "#-}"+  showsPrec d (L_LCURL )    = showString  "{"+  showsPrec d (L_RCURL )    = showString  "}"+  showsPrec d (L_LCURL' )   = showString  "{-start-of-group-}"+  showsPrec d (L_RCURL' )   = showString  "{-end-of-group-}"+  showsPrec d (L_LBRACK )   = showString  "["+  showsPrec d (L_RBRACK )   = showString  "]"+  showsPrec d (L_BACKTICK ) = showString  "`"+  showsPrec d (L_COMMA )    = showString  ","+  showsPrec d (L_SEMI )     = showString  ";"+  showsPrec d (L_SEMI' )    = showString  "{-end-of-definition-}"++  showsPrec d (L_DotDot)       = showString  ".."+  showsPrec d (L_ColonColon)   = showString  "::"+  showsPrec d (L_EqualGreater) = showString  "=>"+  showsPrec d (L_Equal)        = showString  "="+  showsPrec d (L_At)           = showString  "@"+  showsPrec d (L_Lambda)       = showString  "\\"+  showsPrec d (L_Pipe)         = showString  "|"+  showsPrec d (L_Tidle)        = showString  "~"+  showsPrec d (L_LessMinus)    = showString  "<-"+  showsPrec d (L_MinusGreater) = showString  "->"+  showsPrec d (L_Underscore)   = showString  "_ " +  showsPrec d (L_AVARID s)     = shows s+  showsPrec d (L_AVAROP s)     = showChar '(' . shows s . showChar ')'+  showsPrec d (L_ACONID s)     = showsPrec d  s+  showsPrec d (L_ACONOP s)     = showChar '(' . shows s . showChar ')'++  showsPrec d (L_INTEGER i)  = shows i+  showsPrec d (L_RATIONAL i)  = shows i+  showsPrec d (L_DOUBLE f)   = shows f+  showsPrec d (L_CHAR c)     = showString (strChr c)+  showsPrec d (L_STRING s)   = showString (strStr s)++  showsPrec d (L_case )      = showString "_case_"+  showsPrec d (L_class )     = showString "_class_"+  showsPrec d (L_data )      = showString "_data_"+  showsPrec d (L_default )   = showString "_default_"+  showsPrec d (L_deriving )  = showString "_deriving_"+  showsPrec d (L_do )        = showString "_do_"+  showsPrec d (L_else )      = showString "_else_"+  showsPrec d (L_if )        = showString "_if_"+  showsPrec d (L_import )    = showString "_import_"+  showsPrec d (L_in )        = showString "_in_"+  showsPrec d (L_infix )     = showString "_infix_"+  showsPrec d (L_infixl )    = showString "_infixl_"+  showsPrec d (L_infixr )    = showString "_infixr_"+  showsPrec d (L_instance )  = showString "_instance_"+  showsPrec d (L_let )       = showString "_let_"+  showsPrec d (L_module )    = showString "_module_"+  showsPrec d (L_newtype)    = showString "_newtype_"+  showsPrec d (L_of )        = showString "_of_"+  showsPrec d (L_then )      = showString "_then_"+  showsPrec d (L_type )      = showString "_type_"+  showsPrec d (L_where )     = showString "_where_"+--  showsPrec d (L_as )        = showString "_as_"+--  showsPrec d (L_hiding )    = showString "_hiding_"+--  showsPrec d (L_interface ) = showString "_interface_"+--  showsPrec d (L_prefix )    = showString "_prefix_"+--  showsPrec d (L_primitive)  = showString "_primitive_"+--  showsPrec d (L_qualified)  = showString "_qualified_"+--  showsPrec d (L_renaming )  = showString "_renaming_"+--  showsPrec d (L_unboxed)    = showString "_unboxed_"+--  showsPrec d (L_with )      = showString "_with_"
+ compiler98/LexLow.hs view
@@ -0,0 +1,311 @@+module LexLow(lexId,isLexId,isNhcId+             ,lexNum,lexInteger+             ) where++import Data.Ratio+import Data.Char(isAlpha,isUpper,isLower,isDigit)++import Lex+import SysDeps(isAlphaNum)+import TokenId(visible,qualify,t_List)+import Extra(isNhcOp)++data LEX_LOW =		-- the trailing String is the rest of the input+   LEX_ERROR Char String+ | LEX_CONOP String String+ | LEX_VAROP String String+ | LEX_CONID String String+ | LEX_VARID String Int Int String+	-- varid, hash value, length, remainder of input+	-- ( We calculate a hash value for every varid, and match it+	--   against the keywords of the language.  This gives a small+	--   runtime speed up of 5%, compared to the previous+	--   implementation which did explicit character matching on+	--   every varid.  With hashing, only some varids need to be+	--   checked. )++isLexId x =  isAlpha x || isNhcOp x++isLexId' ('_':x:xs) = isLexId x+isLexId' (x:xs) = isLexId x++lexId u r c xs =+  case lexOne u xs of+    LEX_ERROR  ch xs -> (r, c, L_ERROR ch, xs)+    LEX_CONOP  op xs -> (r, c+length op, toConOp op, xs)+    LEX_VAROP  op xs -> (r, c+length op, toVarOp op, xs)+    LEX_VARID var hash len xs ->+        let toVar :: Int -> Lex+            toVar key = case key of+				10 -> word "esac" L_case+				22 -> word "ssalc" L_class+				19 -> word "atad" L_data+				20 -> word "tluafed" L_default+				21 -> word "gnivired" L_deriving+				15 -> word "od" L_do+				4  -> word "esle" L_else+				2 -> word "fi" L_if+				7 -> word "tropmi" L_import+				6 -> word "ni" L_in+				18 -> word "xifni" L_infix+				16 -> word "lxifni" L_infixl+				17 -> word "rxifni" L_infixr+				8 -> word "ecnatsni" L_instance+				14 -> word "tel" L_let+				13 -> word "eludom" L_module+				11 -> word "epytwen" L_newtype+				3 -> word "fo" L_of+				9 -> word "neht" L_then+				5 -> word "epyt" L_type+				12 -> word "erehw" L_where+				1 -> word "_" L_Underscore+				_ -> L_AVARID (visible var)+            word :: String -> Lex -> Lex+            word s tok = if var==s then tok else L_AVARID (visible var)+        in+        (r, c+len, toVar hash, xs)+    LEX_CONID mod ('.':'[':']':xs) -> (r, c+length mod+3, L_ACONID t_List, xs)+	 -- !!! Compiler never emits qualified tuple identifiers, but maybe+	 -- it ought to be recognised anyway+    LEX_CONID mod ('.':xs) | isLexId' xs ->+      let loop mod c' xs = case lexOne u xs of+	    LEX_CONOP  op xs -> (r,c'+length op,L_ACONOP (qualify mod op), xs)+	    LEX_VAROP  op xs -> (r,c'+length op,L_AVAROP (qualify mod op), xs)+	    LEX_VARID var h len xs -> (r,c'+len,L_AVARID (qualify mod var), xs)+	    LEX_CONID con ('#':xs) -> (r,c'+1+length con,+                                           L_ACONID (qualify mod ('#':con)), xs)+	    LEX_CONID con ('.':xs) | isLexId' xs ->+                                       loop (con++'.':mod) (c'+length con+1) xs+  	    LEX_CONID con xs -> (r,c'+length con,L_ACONID (qualify mod con), xs)+      in loop mod (c+length mod+1) xs+    LEX_CONID con ('#':xs) -> (r,c+1+length con,L_ACONID (visible ('#':con)),xs)    +    LEX_CONID con xs -> (r,c+length con,L_ACONID (visible con), xs)    +++------ Read one name++-- first arg is whether underscores are treated as lowercase (=True)+lexOne False xs@('_':':':_) =+  case splitWhile isNhcOp [] xs of+	(op,xs) -> LEX_CONOP op xs+lexOne False xs@('_':x:_) =+  if isNhcOp x+  then case splitWhile isNhcOp [] xs of+	(op,xs) -> LEX_VAROP op xs+  else if isUpper x+  then  case splitWhile isNhcId [] xs of+	(con,xs) -> LEX_CONID con xs+  else if isLower x+  then  case splitWhile isNhcId [] xs of+	(var,xs) -> LEX_VARID var 0 (length var) xs+--else LEX_ERROR x xs	-- maybe better to drop through to lowercase=True ?+  else lexOne True xs++lexOne True xs@('_':_) =+  case splitWhile isNhcId [] xs of+  (var,xs) -> LEX_VARID var 0 (length var) xs++lexOne u xs@(':':_) =+  case splitWhile isNhcOp [] xs of+	(op,xs) -> LEX_CONOP op xs+lexOne u xs@(x:s) =+  if isNhcOp x+  then case splitWhile isNhcOp [] xs of+	(op,xs) -> LEX_VAROP op xs+  else if isUpper x+  then  case splitWhile isNhcId [] xs of+	(con,xs) -> LEX_CONID con xs+  else if isLower x+  then  splitWhileHash isNhcId 1 x [x] s+  else LEX_ERROR x xs+	  +--++isNhcId c = isAlphaNum c || c == '_' || c == '\'' +++----- Check for keywords++toConOp "::" = L_ColonColon+toConOp rop  = L_ACONOP (visible rop)++toVarOp rop =+  case rop of+    ".." -> L_DotDot+    ">=" -> L_EqualGreater+    "="  -> L_Equal+    "@"  -> L_At+    "\\" -> L_Lambda+    "|"  -> L_Pipe+    "~"  -> L_Tidle+    "-<" -> L_LessMinus+    ">-" -> L_MinusGreater+    _    -> L_AVAROP (visible rop)++{-+-- This version of toVar is no longer used - the local definition in+-- lexId above is now used instead.+toVar rid@(i:d) =+       if i == 'f' +  then       if d == "o" then L_of+	else if d == "i" then L_if+			 else L_AVARID (visible rid)+  else if i == 's' +  then       if d == "salc" then L_class+--  	else if d == "a"    then L_as+			    else L_AVARID (visible rid)+  else if i == 't' +  then       if d == "el"      then L_let+  	else if d == "ropmi"   then L_import+  	else if d == "luafed" then L_default+	 		       else L_AVARID (visible rid)+  else if i == 'n' +  then       if d == "eht" then L_then+  	else if d == "i" then L_in+			 else L_AVARID (visible rid)+  else if i == 'e' +  then       if d == "sle"      then L_else+  	else if d == "sac"      then L_case+  	else if d == "rehw"     then L_where+  	else if d == "pyt"      then L_type+  	else if d == "pytwen"   then L_newtype+--  	else if d == "cafretni" then L_interface+  	else if d == "cnatsni"  then L_instance+--  	else if d == "vitimirp" then L_primitive+  	else if d == "ludom"   then L_module+			        else L_AVARID (visible rid)+  else if i == 'o' +  then       if d == "d" then L_do+			 else L_AVARID (visible rid)+  else if i == 'a' +  then       if d == "tad" then L_data+			   else L_AVARID (visible rid)+  else if i == 'x' +  then       if d == "ifni"  then L_infix+--        else if d == "iferp" then L_prefix+			     else L_AVARID (visible rid)+  else if i == 'l' +  then       if d == "xifni" then L_infixl+			     else L_AVARID (visible rid)+  else if i == 'r' +  then       if d == "xifni" then L_infixr+			     else L_AVARID (visible rid)+  else if i == 'g' +  then       if d == "nivired" then L_deriving+-- 	else if d == "nidih"   then L_hiding+			       else L_AVARID (visible rid)+--else if i == 'd' +--then       if d == "eifilauq" then L_qualified+--        else if d == "exobnu"   then L_unboxed+--			        else L_AVARID (visible rid)+  else if i == '_' && null d+  then L_Underscore++  else L_AVARID (visible rid)+-}++---- read number++lexNum :: Int -> Int -> String -> (Int, Int, Lex, String)+lexNum r c ('0':b:xs) =+  if b == 'o' || b == 'O' then +    case lexInteger 8 (c+2) xs of+      (c',i,xs') -> (r,c', L_INTEGER i, xs')+  else if b == 'x' || b == 'X' then +    case lexInteger 16 (c+2) xs of+      (c',i,xs') -> (r,c', L_INTEGER i, xs')+  else+    lexNum' r (c+1) (b:xs)+lexNum r c xs = lexNum' r c xs++lexNum' r c xs =+       case lexInteger 10 c xs of+           (c',i,'.':xs') | okNum xs' ->  +                (lexHelp i (lexFrac c' xs'))+           (c',i,xs'@(e:_)) | e`elem`"eE" && okNum xs' ->+                (lexHelp i (lexFrac c' xs'))+           (c',i,xs') ->+                (r,c', L_INTEGER i, xs')+        where+		okNum ('e':'-':x:_) = isDigit x+		okNum ('e':'+':x:_) = isDigit x+		okNum ('e':x:_) = isDigit x+		okNum ('E':'-':x:_) = isDigit x+		okNum ('E':'+':x:_) = isDigit x+		okNum ('E':x:_) = isDigit x+		okNum (x:_) = isDigit x+		okNum _ = False++                lexHelp i (c'',s,m,e:xs'') | (e == 'e' || e == 'E') =+                        case lexExp c'' xs'' of+                          (c''',e,xs''') -> (r,c''',L_RATIONAL ((((i*s+m)%s)::Rational)*10^^e),xs''')+---                          (c''',e,xs''') -> (r,c''',L_RATIONAL ((((i*s+m)%s)::Rational){-*(fromInteger 10^^e)-}),xs''')   --- GOFER ONLY !!!+                lexHelp i (c'',s,m,xs'') =+                        (r,c'',L_RATIONAL ((i*s+m) % s),xs'')+++                lexExp :: Int -> String -> (Int,Integer,String)+                lexExp c ('-':xs) = case lexInteger 10 (c+1) xs of+                                        (c',i,xs') -> (c',-i,xs')+                lexExp c ('+':xs) = lexInteger 10 (c+1) xs+                lexExp c xs       = lexInteger 10 c xs++                lexFrac :: Int -> String -> (Int,Integer,Integer,String)+                lexFrac c xs = pF c 1 0 xs++                pF :: Int -> Integer -> Integer -> String -> (Int,Integer,Integer,String)+                pF c s a []    = (c,s,a,[])+                pF c s a (xxs@(x:xs)) =+                                 if dx < 10 then+                                     pF (c+1) (s*10) (a*10 + dx) xs+                                 else+                                     (c,s,a,xxs)+                                        where dx = digit x+++lexInteger :: Integer -> Int -> String -> (Int,Integer,String)+lexInteger b c xs = pI b c 0 xs+        where+                pI :: Integer -> Int -> Integer -> String -> (Int,Integer,String)+                pI b c a []    = (c,a,[])+                pI b c a (xxs@(x:xs)) =+                                 if dx < b then+                                     pI b (c+1) (a*b+dx) xs+                                 else+                                     (c,a,xxs)+                                        where dx = digit x++--++digit :: Char -> Integer+digit '0' =  0; digit '1' =  1; digit '2' =  2; digit '3' =  3; digit '4' =  4+digit '5' =  5; digit '6' =  6; digit '7' =  7; digit '8' =  8; digit '9' =  9+digit 'a' = 10; digit 'A' = 10; digit 'b' = 11; digit 'B' = 11+digit 'c' = 12; digit 'C' = 12; digit 'd' = 13; digit 'D' = 13+digit 'e' = 14; digit 'E' = 14; digit 'f' = 15; digit 'F' = 15+digit  _  = 1000++splitWhile p a [] = (a,[])+splitWhile p a xxs@(x:xs) =+	if p x+	then splitWhile p (x:a) xs+	else (a,xxs)++splitWhileHash :: (Char->Bool)		-- predicate+		 -> Int			-- accumulated length+		 -> Char		-- first char+		 -> String		-- accumulated (reversed) lexeme+		 -> String		-- input string+		 -> LEX_LOW	-- Always (LEX_VARID String Int Int String)+				-- (lexeme, hash value, length, rest of input)+splitWhileHash p len h acc []+	= LEX_VARID acc (hash h + hash (head acc) + len) len []+splitWhileHash p len h acc xxs@(x:xs)+	| p x        = splitWhileHash p (len+1) h (x:acc) xs+	| otherwise  = LEX_VARID acc (hash h + hash (head acc) + len) len xxs++hash :: Char -> Int+hash c = case c of { 's'-> 11; '_'-> 0;  'a'-> 3;  'g'-> 1; 'o'-> 1;+                     'x'-> 13; 'r'-> 11; 'd'-> 12; 'f'-> 0; 'l'-> 10;+                     'm'-> 7;  'w'-> 7;  'c'-> 6;  'n'-> 4; 't'-> 1;+                     'i'-> 0;  'e'-> 0;  _  -> 100 }
+ compiler98/LexPre.hs view
@@ -0,0 +1,161 @@+module LexPre(lexPre,PosTokenPre) where++import Data.Char(isSpace,isDigit,isAlpha)++import Lex+import LexLow+import LexStr	-- includes: tab,lexChr+import SysDeps(PackedString,packString,isAlphaNum)+import TokenId(t_List,t_Arrow,t_Tuple)+import Extra(Pos,toPos)++type PosTokenPre = (PackedString,Pos,Int,Lex)+                -- filename, position, column, lexem+                -- column is that of position start+                -- repeated here for easy access++lexPre :: Bool -> PackedString -> String -> [PosTokenPre]+lexPre u file l = iPreLex u file 1 1 l++------- local++iPreLex :: Bool -> PackedString -> Int -> Int -> String -> [PosTokenPre]+                -- filename       line   column   input+iPreLex u file r c []              = [(file,toPos r 0 r 0,0,L_EOF)]+iPreLex u file r c ('\n':xs)       = iPreLex u file (r+1) 1 xs+iPreLex u file r c ('\^M':'\n':xs) = iPreLex u file (r+1) 1 xs	-- DOS line-end+iPreLex u file r c ('\^M':xs)      = iPreLex u file (r+1) 1 xs	-- Mac line-end+iPreLex u file r c (' ':xs)        = iPreLex u file r (c+1) xs+iPreLex u file r c ('\xa0':xs)     = iPreLex u file r (c+1) xs	-- &nbsp;+iPreLex u file r c ('\t':xs)       = iPreLex u file r (tab c) xs+iPreLex u file r c ('-':'-':xs)+  | null munch || isSpace nextchr || nextchr `elem` ",()[]{};\"'`"+     || isAlphaNum nextchr = skipline (iPreLex u file (r+1) 1) xs+	where+		munch = dropWhile (=='-') xs+                nextchr = head munch+		skipline :: (String->[PosTokenPre]) -> String -> [PosTokenPre]+		skipline cont [] = cont []+		skipline cont ('\n':r) = cont r+		skipline cont (_:r) = skipline cont r+iPreLex u file r c ('{':'-':'#':xs) =+                case words xs of+                  ("LINE":lineno:newfile:"#-}":_) | all isDigit lineno ->+                          case lexInteger 10 0 lineno of+                            (_,newr,_) ->+                               iPreLex u (packString newfile)+                                         (fromInteger newr) 1+                                         (tail (dropWhile (/='\n') xs))+                  ("NEED":_) ->+                          (file,toPos r c r (c+2),c,L_LANNOT) +                          : iPreLex u file r (c+3) xs+                  ("#-}":_) ->+                          (file,toPos r c r (c+2),c,L_LANNOT) +                           : iPreLex u file r (c+3) xs+                  (name:_) | all isDigit name ->	-- e.g. fn arity+                          (file,toPos r c r (c+2),c,L_LANNOT) +                           : iPreLex u file r (c+3) xs+                  _ ->    skipcomment u file 0 r (c+3) xs+iPreLex u file r c ('#':'-':'}':xs) =+                (file,toPos r c r (c+2),c,L_RANNOT): iPreLex u file r (c+3) xs++iPreLex u file r c ('{':'-':xs)     = skipcomment u file 0 r (c+2) xs+iPreLex u file r c ('(':xs) | isTupleId xs =+   case span (==',') xs of+     (commas,')':xs) -> + 	case length commas of+	-- unit ()+	  0 -> (file,toPos r c r (c+2),c,L_ACONID (t_Tuple 0))+               : iPreLex u file r (c+3) xs+	-- (n+1)-tuple +	  n -> (file,toPos r c r (c+n+1),c,L_ACONID (t_Tuple (n+1)))+               : iPreLex u file r (c+n+2) xs+ where+   isTupleId xs =+      case dropWhile (==',') xs of+	(')':_) -> True+	_ -> False++iPreLex u file r c ('(':'-':'>':')':xs) = +  (file,toPos r c r (c+3),c,L_ACONID t_Arrow) : iPreLex u file r (c+4) xs+iPreLex u file r c ('(':xs) = +  (file,toPos r c r c,c,L_LPAR) : iPreLex u file r (c+1) xs+iPreLex u file r c (')':xs) = +  (file,toPos r c r c,c,L_RPAR) : iPreLex u file r (c+1) xs+iPreLex u file r c (',':xs) = +  (file,toPos r c r c,c,L_COMMA) : iPreLex u file r (c+1) xs+iPreLex u file r c ('{':xs) = +  (file,toPos r c r c,c,L_LCURL) : iPreLex u file r (c+1) xs+iPreLex u file r c ('}':xs) = +  (file,toPos r c r c,c,L_RCURL) : iPreLex u file r (c+1) xs+iPreLex u file r c ('[':']':xs) = +  (file,toPos r c r (c+1),c,L_ACONID t_List) : iPreLex u file r (c+2) xs+iPreLex u file r c ('[':xs) = +  (file,toPos r c r c,c,L_LBRACK) : iPreLex u file r (c+1) xs+iPreLex u file r c (']':xs) = +  (file,toPos r c r c,c,L_RBRACK) : iPreLex u file r (c+1) xs+iPreLex u file r c ('`':xs) = +  (file,toPos r c r c,c,L_BACKTICK) : iPreLex u file r (c+1) xs+iPreLex u file r c (';':xs) = +  (file,toPos r c r c,c,L_SEMI) : iPreLex u file r (c+1) xs+iPreLex u file r c ('#':xs) | c == 1 =+       case span ('\n' /=) xs of+         (line,xs) ->+            case words line of+              ("line":line:file:_) | all isDigit line ->+                case lexInteger 10 0 line of+                  (_,r,_) ->+                      iPreLex u (packString file) (fromInteger r) 1 (tail xs)+              (line:file:_) | all isDigit line ->+                case lexInteger 10 0 line of+                  (_,r,_) ->+                      iPreLex u (packString file) (fromInteger r) 1 (tail xs)+              ("pragma":_) -> iPreLex u file r c xs  -- skip verbiage+              _ -> error ("Unknown preprocessor directive at line " ++ show r+                         ++ ( case show file of {+                                "\"\"" -> [];+                                file   -> " in file " ++ file } )+                         ++ "\n" ++ line ++ "\n")+-- both lexStr, lexChr, lexId etc return c' > 1 +iPreLex u file r c ('"':xs) = +  (file,toPos r c r' (c'-1),c,L_STRING st) : iPreLex u file r' c' xs'+	where (r',c',st,xs') = lexStr r (c+1) xs+iPreLex u file r c ('\'':xs)= +  (file,toPos r c r' (c'-1),c,L_CHAR ch) : iPreLex u file r' c' xs'+	where (r',c',ch,xs') = lexChr r (c+1) xs++iPreLex u file r c ('_':[]) = +  (file,toPos r c r c,c,L_Underscore) : iPreLex u file r (c+1) []+iPreLex u file r c xxs@('_':xs@(x:_)) =+  if isNhcId x+    then case lexId u r c xxs of+	   (r,c',lex,xs) -> +             (file,toPos r c r (c'-1),c,lex) : iPreLex u file r c' xs+    else (file,toPos r c r c,c,L_Underscore) : iPreLex u file r (c+1) xs+iPreLex u file r c (xs@(x:s))=+  if isLexId x+    then case lexId u r c xs of+	   (r,c',lex,xs) -> +             (file,toPos r c r (c'-1),c,lex) : iPreLex u file r c' xs+    else if isDigit x+    then case lexNum r c xs of+	   (r,c',lex,xs) -> +             (file,toPos r c r (c'-1),c,lex) : iPreLex u file r c' xs+    else (file,toPos r c r c,c,L_ERROR x) : iPreLex u file r c s+++++-- Auxiliary used by more than one clause of iPreLex (originally a local defn)+skipcomment :: Bool -> PackedString ->Int ->Int ->Int ->String ->[PosTokenPre]+skipcomment u file n r c xs = skip n r c xs+  where+    skip :: Int -> Int -> Int -> String -> [PosTokenPre]+    skip n r c []           = iPreLex u file r c []+    skip n r c ('-':'}':xs) = if n > 0 +				 then skip (n-1) r (c+2) xs+				 else iPreLex u file r (c+2) xs+    skip n r c ('{':'-':xs) = skip (n+1) r   (c+2) xs+    skip n r c ('\n':xs)    = skip n    (r+1)    1 xs+    skip n r c ('\t':xs)    = skip n     r (tab c) xs+    skip n r c (_:xs)       = skip n     r   (c+1) xs
+ compiler98/LexStr.hs view
@@ -0,0 +1,119 @@+module LexStr(tab,lexStr,lexChr) where++import Data.Char++import Error(errorLC)+import LexLow++tab :: Int -> Int+tab l = (m*8+1) where m = (l+7)`div`8++lexStr :: Int->Int->[Char] -> (Int,Int,[Char],[Char])+lexStr r c xs = pS '"' (r,c) r c [] xs++lexChr :: Int->Int->[Char] -> (Int,Int,Char,[Char])+lexChr r c xs = case pS '\'' (r,c) r c [] xs of+                (r',c',[ch],xs') -> (r',c',ch,xs')+                (_,_,[] ,_) -> errorLC r c "Empty character literal."+                (_,_,cs ,_) -> errorLC r c ("Character literal with length>1 '"+                                            ++ cs ++ "'.")++---- local+++pS :: Char -> (Int,Int) -> Int -> Int -> [Char] -> [Char]+      -> (Int,Int,[Char],[Char])+pS d (ro,co) r c a []  = errorLC ro co "Unterminated literal string/character."+pS d  roco   r c a ('\n':_) = errorLC r c ("Newline in literal string/char."+                                           ++"\nUse \\n instead.")+pS d  roco   r c a ('\t':_) = errorLC r c ("Tab in literal string/char."+                                           ++"\nUse \\t instead.")+pS d  roco   r c a ('\f':_) = errorLC r c ("Linefeed in literal string/char."+                                           ++"\nUse \\f instead.")+pS d  roco   r c a ('\v':_) = errorLC r c ("Vertical tab in literal string/char"+                                           ++".\nUse \\v instead.")+pS d  roco   r c a ('\\':'&':xs) = pS d roco r (c+2) a xs+pS d  roco   r c a ('\\':'a':xs) = pS d roco r (c+2) ('\a':a) xs+pS d  roco   r c a ('\\':'b':xs) = pS d roco r (c+2) ('\b':a) xs+pS d  roco   r c a ('\\':'f':xs) = pS d roco r (c+2) ('\f':a) xs+pS d  roco   r c a ('\\':'n':xs) = pS d roco r (c+2) ('\n':a) xs+pS d  roco   r c a ('\\':'r':xs) = pS d roco r (c+2) ('\r':a) xs+pS d  roco   r c a ('\\':'t':xs) = pS d roco r (c+2) ('\t':a) xs+pS d  roco   r c a ('\\':'v':xs) = pS d roco r (c+2) ('\v':a) xs+pS d  roco   r c a ('\\':'\\':xs) = pS d roco r (c+2) ('\\':a) xs+pS d  roco   r c a ('\\':'"':xs) = pS d roco r (c+2) ('"':a) xs+pS d  roco   r c a ('\\':'\'':xs)= pS d roco r (c+2) ('\'':a) xs+pS d  roco   r c a ('\\':'N':'U':'L':xs) = pS d roco r (c+4) ('\NUL':a) xs+pS d  roco   r c a ('\\':'S':'O':'H':xs) = pS d roco r (c+4) ('\SOH':a) xs+pS d  roco   r c a ('\\':'S':'T':'X':xs) = pS d roco r (c+4) ('\STX':a) xs+pS d  roco   r c a ('\\':'E':'T':'X':xs) = pS d roco r (c+4) ('\ETX':a) xs+pS d  roco   r c a ('\\':'E':'O':'T':xs) = pS d roco r (c+4) ('\EOT':a) xs+pS d  roco   r c a ('\\':'E':'N':'Q':xs) = pS d roco r (c+4) ('\ENQ':a) xs+pS d  roco   r c a ('\\':'A':'C':'K':xs) = pS d roco r (c+4) ('\ACK':a) xs+pS d  roco   r c a ('\\':'B':'E':'L':xs) = pS d roco r (c+4) ('\BEL':a) xs+pS d  roco   r c a ('\\':'B':'S':xs)     = pS d roco r (c+3) ('\BS':a) xs+pS d  roco   r c a ('\\':'H':'T':xs)     = pS d roco r (c+3) ('\HT':a) xs+pS d  roco   r c a ('\\':'L':'F':xs)     = pS d roco r (c+3) ('\LF':a) xs+pS d  roco   r c a ('\\':'V':'T':xs)     = pS d roco r (c+3) ('\VT':a) xs+pS d  roco   r c a ('\\':'F':'F':xs)     = pS d roco r (c+3) ('\FF':a) xs+pS d  roco   r c a ('\\':'C':'R':xs)     = pS d roco r (c+3) ('\CR':a) xs+pS d  roco   r c a ('\\':'S':'O':xs)     = pS d roco r (c+3) ('\SO':a) xs+pS d  roco   r c a ('\\':'S':'I':xs)     = pS d roco r (c+3) ('\SI':a) xs+pS d  roco   r c a ('\\':'D':'L':'E':xs) = pS d roco r (c+4) ('\DLE':a) xs+pS d  roco   r c a ('\\':'D':'C':'1':xs) = pS d roco r (c+4) ('\DC1':a) xs+pS d  roco   r c a ('\\':'D':'C':'2':xs) = pS d roco r (c+4) ('\DC2':a) xs+pS d  roco   r c a ('\\':'D':'C':'3':xs) = pS d roco r (c+4) ('\DC3':a) xs+pS d  roco   r c a ('\\':'D':'C':'4':xs) = pS d roco r (c+4) ('\DC4':a) xs+pS d  roco   r c a ('\\':'N':'A':'K':xs) = pS d roco r (c+4) ('\NAK':a) xs+pS d  roco   r c a ('\\':'S':'Y':'N':xs) = pS d roco r (c+4) ('\SYN':a) xs+pS d  roco   r c a ('\\':'E':'T':'B':xs) = pS d roco r (c+4) ('\ETB':a) xs+pS d  roco   r c a ('\\':'C':'A':'N':xs) = pS d roco r (c+4) ('\CAN':a) xs+pS d  roco   r c a ('\\':'E':'M':xs)     = pS d roco r (c+3) ('\EM':a) xs+pS d  roco   r c a ('\\':'S':'U':'B':xs) = pS d roco r (c+4) ('\SUB':a) xs+pS d  roco   r c a ('\\':'E':'S':'C':xs) = pS d roco r (c+4) ('\ESC':a) xs+pS d  roco   r c a ('\\':'F':'S':xs)     = pS d roco r (c+3) ('\FS':a) xs+pS d  roco   r c a ('\\':'G':'S':xs)     = pS d roco r (c+3) ('\GS':a) xs+pS d  roco   r c a ('\\':'R':'S':xs)     = pS d roco r (c+3) ('\RS':a) xs+pS d  roco   r c a ('\\':'U':'S':xs)     = pS d roco r (c+3) ('\US':a) xs+pS d  roco   r c a ('\\':'S':'P':xs)     = pS d roco r (c+3) ('\SP':a) xs+pS d  roco   r c a ('\\':'D':'E':'L':xs) = pS d roco r (c+4) ('\DEL':a) xs+pS d  roco   r c a ('\\':'^':x:xs) =+      if ox >= 64 && ox <96 then     -- Fusk ?+          pS d roco r (c+3) (toEnum (ox-64):a) xs +      else+          errorLC r c ("Illegal control character '\\^" ++ [x]+                        ++ "' in string or character literal.")+      where ox = fromEnum x+pS d  roco   r c a ('\\':'o':xs) = pS d roco r c' (toEnum (fromInteger n):a) xs'+      where (c',n,xs') = lexInteger  8 (c+2) xs+pS d  roco   r c a ('\\':'x':xs) = pS d roco r c' (toEnum (fromInteger n):a) xs'+      where (c',n,xs') = lexInteger (8+8) (c+2) xs+pS d  roco   r c a ('\\':' ':xs)  = pS d roco r' c' a xs'+      where (r',c',xs') = pW r (c+2) xs+pS d  roco   r c a ('\\':'\t':xs) = pS d roco r' c' a xs'+      where (r',c',xs') = pW r (tab(c+1)) xs+pS d  roco   r c a ('\\':'\n':xs) = pS d roco r' c' a xs'+      where (r',c',xs') = pW (r+1) 1 xs+pS d  roco   r c a ('\\':x:xs) =+      if isDigit x then+          case lexInteger 10 (c+1) (x:xs) of+		 (c',i,xs') -> pS d roco r c' (toEnum (fromInteger i):a) xs'+      else+          errorLC r c ("Illegal escape character '" ++ x: "'.")+pS d  roco   r c a (x:xs) =+      if d == x then+          (r,c+1,reverse a,xs)+      else+          pS d roco r (c+1) (x:a) xs++pW :: Int -> Int -> [Char] -> (Int,Int,[Char])+pW r c [] =    errorLC r c "End of file in string gap."+pW r c ('\\':xs) = (r,c+1,xs)+pW r c (' ':xs) =  pW r (c+1) xs+pW r c ('\t':xs) = pW r (tab c) xs+pW r c ('\n':xs) = pW (r+1) 1 xs+pW r c ('\f':xs) = pW (r+1) 1 xs+pW r c ('\v':xs) = pW (r+1) 1 xs+pW r c (x:xs) = errorLC r c ("Illegal character in string gap '" ++ x:"'.")++
+ compiler98/Lexical.hs view
@@ -0,0 +1,95 @@+{-+Lexical analysis of a file.+-}++module Lexical(lexical,lexicalCont,Lex+                ,LexState,PosToken,PosTokenPre,Pos) where++import Extra(Pos,toPos,strPos,insertPos)+import Lex+import LexPre+import SysDeps(PackedString,packString,unpackPS)+import TokenId++type PosToken = (Pos,Lex, LexState, [PosTokenPre])+type LexState = [Int]  -- stack of indentations of {} blocks++-- 0 : no active indentation (explicit layout)++lexical :: Bool -> [Char] -> [Char] -> [PosToken]+ -- with H'98 underscore -> filename -> file content -> tokens+-- lexPre basically does the lexing, but afterwards iLex handles+-- indentation for the layout rule+lexical u file l = iLex [0] 0 (beginning (lexPre u file' l))+  where+    file' = packString file+    -- handle pragmas and start and missing "module" header+    beginning :: [PosTokenPre] -> [PosTokenPre]+    beginning toks =+       case toks of+           lp@((f,r,c,L_module):_)    ->  lp+           lp@((f,r,c,L_AVARID t):_) | t==tinterface ->  lp+           (lp@(f,r,c,L_LANNOT):rest) ->  lp: discard_pragma rest+           lp                         ->  ((file',toPos 1 0 0 0,0,L_module)+                                          :(file',toPos 1 0 0 0,0,L_ACONID tMain)+                                          :(file',toPos 1 0 0 0,0,L_where)+                                          :lp)+    discard_pragma (lp@(f,r,c,L_RANNOT):rest) = lp: beginning rest+    discard_pragma (lp@(f,r,c,_):rest)        = lp: discard_pragma rest++lexicalCont :: PosToken -> Either String [PosToken]+lexicalCont (p,t,(i:s@(i':_)),r) =+                if i > 0+                then -- Right ((p,t,s,r) : iLex s i' r) -- not correct?+                     case r of+                       ((f,_,_,_):_) -> Right (piLex f s i' p t r)+                else Left "Layout }"+lexicalCont (p,t, []  ,r) = +                Left "Layout }"++---  local++iLex :: LexState -> Int -> [PosTokenPre] -> [PosToken]+iLex s i [] = []+iLex s i ((f,p,c,t):pt) = +  seq p $+  if c > i then+    piLex f s i p t pt+  else if c == i && i /= 0 && t /= L_in then+    seq p' $ (p',L_SEMI',s,pt) : piLex f s i p t pt+  else if c == 0 && i == 0 then+    piLex f s i p t pt+  else+    seq p' $ (p',L_RCURL',s,pt) : iLex s' i' ((f,p,c,t):pt)+  where+  (_:s'@(i':_)) = s+  p' = insertPos p++piLex :: PackedString -> LexState -> Int -> Pos -> Lex -> [PosTokenPre] +      -> [PosToken]+piLex file s i p tok tr@((f,p',c,t'):pt)+      | tok `elem` [L_let, L_where, L_of, L_do] =+          (p,tok,s,tr)+          : if t' == L_LCURL +              then seq p' $ (p',L_LCURL, s,pt) : iLex (0:s) 0 pt +            else+                let p'' = insertPos p' in seq p'' $ (p'', L_LCURL',s,tr)+                : if c > i then+                    seq p' $ piLex f (c:s) c p' t' pt+                  else+                    (p, L_RCURL',s,tr) : iLex s i tr+piLex file s i p L_LCURL  pt =+          (p,L_LCURL,s,pt)+          : iLex (0:s) 0 pt+piLex file s i p L_RCURL  pt = +      if i == 0+      then case s of +             (_:s'@(i':_)) -> (p,L_RCURL,s,pt) : iLex s' i' pt+             _             -> failPos file p "Unbalanced '}' (Stack empty)."+      else failPos file p "Unbalanced '}' (No explicit '{' in scope)"+piLex file s i p t pt  =+          (p,t,s,pt)+          : iLex s i pt+++failPos file p msg = error ("Internal in " ++ unpackPS file ++ " at " ++ strPos p ++ ": " ++ msg ++ "\n")
+ compiler98/MergeSort.hs view
@@ -0,0 +1,16 @@+module MergeSort(group,unique) where++import Data.List(sort)++group l = groupSorted (sort l)++groupSorted [] = []+groupSorted (x:xs) = groupSorted' x [] xs+        where+            groupSorted' x a [] = [x:a]+            groupSorted' x a (y:ys) =+                if x == y+                then groupSorted' x (y:a) ys+                else (x:a) : groupSorted' y [] ys++unique xs = map head (group xs)
+ compiler98/MkSyntax.hs view
@@ -0,0 +1,200 @@+{- ---------------------------------------------------------------------------+Make parts of Haskell syntax tree+-}+module MkSyntax+	( mkAppExp, mkAppInst, mkCase, mkDeclClass+	, mkDeclFun, mkDeclPat, mkDeclPatFun, mkEnumFrom+	, mkEnumThenFrom, mkEnumToFrom, mkEnumToThenFrom+        , mkLambda, mkLet, mkDo, mkFieldExp,mkExpList+	, mkExpListComp, mkIf, mkInfixList+	, mkInstList, mkInt, mkParExp, mkParInst, mkParType+	, mkTypeList, mkPatNplusK, mkParLhs+	) where++import Extra(Pos,noPos,mergePos,mergePoss)+import TokenId+import Syntax+import SyntaxPos(HasPos(getPos))+++mkParType :: Pos -> [Type TokenId] -> Type TokenId+mkParType p [t] = t+mkParType p ts  = TypeCons p (t_Tuple (length ts)) ts+++mkAppInst :: (Pos,a) -> [(Pos,a)] -> Type a+mkAppInst (p,c) ts = TypeCons p c (map (uncurry TypeVar) ts)+++mkInfixList [e] = e+mkInfixList es = ExpInfixList (getPos es) es+++mkParInst p [t] = error ("mkParInst on singleton list")+mkParInst p ts  = TypeCons p (t_Tuple (length ts)) (map (uncurry TypeVar) ts)+++mkInstList p id = TypeCons p t_List [TypeVar p id]+++mkDeclPat :: (Pos,a) -> Exp a -> Exp a -> Rhs a -> Decls a -> Decl a+mkDeclPat (pv,var) op e@(ExpInfixList pos es) gdexps w =+	DeclPat (Alt (ExpInfixList pos [ExpVar pv var,op,e]) gdexps w)+mkDeclPat (pv,var) op e gdexps w =+	DeclPat (Alt (ExpInfixList pv [ExpVar pv var,op,e]) gdexps w)+++mkDeclFun :: (Pos,a) -> [Pat a] -> Rhs a -> Decls a -> Decl a+--mkDeclFun (pv,var) [] gdexps w =+--	DeclPat (Alt (ExpVar pv var) gdexps w)+mkDeclFun (pv,var) pats gdexps w =+  DeclFun (mergePoss [pv `min` getPos pats,getPos gdexps,getPos w]) +    var [Fun pats gdexps w]+++mkDeclPatFun :: Alt a -> Decl a+mkDeclPatFun  (Alt (ExpVar pos fun) gdexps w) =+  DeclFun (mergePoss [pos,getPos gdexps,getPos w]) fun [Fun [] gdexps w]+--        DeclPat (Alt (ExpVar pos fun) gdexps w)+mkDeclPatFun  (Alt (ExpInfixList _ [ExpVar pos fun]) gdexps w) =+  DeclFun (mergePoss [pos,getPos gdexps,getPos w]) fun [Fun [] gdexps w]+mkDeclPatFun  (Alt (ExpInfixList _ (ExpVar pos fun:qop:args)) gdexps w) +  | notOp qop = DeclFun (mergePoss [pos,getPos gdexps,getPos w]) fun +                  [Fun (qop:args) gdexps w]+mkDeclPatFun alt = DeclPat alt++notOp (ExpConOp _ _) = False+notOp (ExpVarOp _ _) = False+notOp _ = True++--mkRevTypeArrow p a b = TypeCons p t_Arrow [b,a]+mkTypeList p t = TypeCons p t_List [t]++-- passes position of lambda+mkLambda pos pats e = +  let p = mergePos pos (getPos e) in p `seq` ExpLambda p pats e++-- passes position of let+mkLet pos decls e =+  let p = mergePos pos (getPos e) in p `seq` ExpLet p decls e++-- passes position of do+mkDo pos stmts =+  let p = mergePos pos (getPos stmts) in p `seq` ExpDo p stmts++-- passes position of if+mkIf pos e1 e2 e3 =+  let p = mergePos pos (getPos e3) in p `seq` ExpIf p e1 e2 e3++-- passes position of case+mkCase pos e alts =+  let p = mergePos pos (getPos alts) in p `seq` ExpCase p e alts+++mkEnumFrom pos eFrom =+        ExpApplication pos [ExpVar pos tenumFrom,eFrom]+mkEnumToFrom pos eTo eFrom =+        ExpApplication pos [ExpVar pos tenumFromTo,eFrom,eTo]+mkEnumThenFrom pos eThen eFrom =+        ExpApplication pos [ExpVar pos tenumFromThen,eFrom,eThen]+mkEnumToThenFrom pos eTo eThen eFrom =+        ExpApplication pos [ExpVar pos tenumFromThenTo,eFrom,eThen,eTo]+++mkAppExp [] = error "mkAppExp"+mkAppExp [e] = e+mkAppExp es@[e1,e2] = +  ExpApplication (mergePos (getPos e1) (getPos e2)) es+mkAppExp es@(e1:e2:es') =+  ExpApplication (mergePos (min (getPos e1) (getPos e2)) (getPos (last es'))) +    es+  -- operator of infix expression is in front and first argument next++-- passes positions of left and right parenthesis+mkParExp posl [ExpConOp pos' id] posr = ExpCon pos' id+mkParExp posl [ExpVarOp pos' id] posr = ExpVar pos' id+mkParExp posl [e] posr = e+mkParExp posl es  posr = +  let p = mergePos posl posr +  in p `seq` ExpApplication p (ExpCon p (t_Tuple (length es)):es)++mkFieldExp pos ident exp =+  let p = mergePos pos (getPos exp) in p `seq` FieldExp pos ident exp++-- passes positions of left and right brackets+mkExpList posl exps posr =+  let p = mergePos posl posr in p `seq` ExpList p exps++mkParLhs pos app args = ExpApplication pos (app:args)++-- combineGroups (DeclsParse d1) (DeclsParse d2) = DeclsParse (d1++d2)+-- +-- mkDeclClass ctx (pos,cls) (_,arg) (csigns,valdefs) =+--             DeclClass pos ctx cls arg (combineGroups csigns valdefs)++-- changed in H98 to:+mkDeclClass ctx (pos,cls) posargs fundeps cdecls =+    DeclClass pos ctx cls (map snd posargs) fundeps cdecls+++mkExp_Colon :: Pos -> Exp TokenId+mkExp_Colon pos  = ExpCon pos t_Colon++mkExp_filter :: Pos -> Exp TokenId+mkExp_filter pos  = ExpVar pos t_filter++mkExp_foldr :: Pos -> Exp TokenId+mkExp_foldr pos  = ExpVar pos t_foldr++mkExp_x :: Pos -> Exp TokenId+mkExp_x pos  = ExpVar pos t_x+mkExp_y :: Pos -> Exp TokenId+mkExp_y pos  = ExpVar pos t_y+++mkExpListComp pos qs e = ExpApplication noPos [trans pos qs e,ExpList noPos []]+ where+  trans pos [] e =+    ExpApplication pos+        [mkExp_Colon pos+        ,e+        ]+  trans pos (QualLet decls:qs) e =+    ExpLet pos decls (trans pos qs e)+  trans pos (QualExp exp:qs) e =+    ExpApplication pos+        [mkExp_filter pos+        ,exp+        ,trans pos qs e+        ]+  trans pos (QualPatExp pat exp:qs) e =+    ExpApplication pos+        [mkExp_foldr pos+        ,ExpLambda pos+            [mkExp_x noPos,mkExp_y pos]+            (ExpCase noPos (mkExp_x pos)+              [Alt pat+                   (Unguarded (ExpApplication pos [trans pos qs e,mkExp_y pos]))+                   (DeclsParse [])+              ,Alt (PatWildcard pos)+                   (Unguarded (mkExp_y pos))+                   (DeclsParse [])+              ]+            )+        ,exp+        ]+++mkInt pos i = ExpLit pos (LitInt Boxed i)++mkPatNplusK (pos,tid) (posi,integer) =+  let p = mergePos pos posi in p `seq` +    PatNplusK p tid undefined (ExpLit posi integer) undefined undefined+-- While parsing (n+k), can't choose a unique replacement identifier n',+-- so leave some fields to be filled in later.++--  let k = ExpLit posi integer in+--  PatNplusK pos tid undefined k (ExpApplication pos [t_lessequal,k])+--                                (ExpApplication pos [t_subtract,k])++{- End Module MkSyntax ------------------------------------------------------}
+ compiler98/NT.hs view
@@ -0,0 +1,181 @@+module NT ( NT(..), NewType(..), Kind(..)+	, mkNTvar, mkNTexist, mkNTcons+	, anyNT, consNT, freeNT, freshNT, polyNT, strTVar+	, sndNTvar, strNT, strictNT, transCtxs, useNT+	, contextNT, ntContext2Pair, stripNT, anyVarNT+	) where+++import Id(Id)+import Extra(mixComma,mixSpace,mix)+import Data.Char++infixr 5 :->:+data Kind = Star | Kind :->: Kind deriving (Eq,Ord)++-- Perhaps NewType is a type schema?  It quantifies variables over+-- an arrow of NTs.+data NewType = NoType+             | NewType [Id]       -- universally quantified type variables+                       [Id]       -- existentially quantified type variables+                       [(Id,Id)]  -- context (class, type variable)+                       [NT]       -- simple types +                                  -- ex.: [Int,Char,Bool] = Int->Char->Bool+             deriving (Eq)++instance Show NewType where+  showsPrec d (NoType) =  showString " -- no type --"+  showsPrec d (NewType free exist ctxs nts) = +    showString (strTVarsCtxsNTs free ctxs nts)++data NT = NTany   Id       -- can be instantiated with unboxed +                           -- (needed during type checking)+        | NTvar   Id Kind+        | NTexist Id Kind+        | NTstrict NT+	| NTapp   NT NT+        | NTcons  Id Kind [NT] 	-- combines constructor + application+        | NTcontext Id Id  -- context (class, type variable)+                           -- purpose here completely unclear (used?)+         deriving (Eq,Ord)++mkNTvar v = NTvar v Star	-- simple tyvar+mkNTexist v = NTexist v Star	-- simple tyvar++mkNTcons i nts = NTcons i kind nts+    where kind = foldr (:->:) Star (map kindNT nts)++kindNT (NTany _) = Star+kindNT (NTvar _ k) = k+kindNT (NTexist _ k) = k+kindNT (NTapp nt1 nt2) = case (kindNT nt1) of (_:->:k) -> k+kindNT (NTcons _ k nts) = foldl (\(_:->:k') _ -> k') k nts+kindNT (NTcontext _ _) = Star++stripNT (NTany   v)   = v+stripNT (NTvar   v _) = v+stripNT (NTexist v _) = v+stripNT (NTapp (NTvar v _) nt ) = v+stripNT nt = error ("stripNT on " ++ show nt)++strictNT (NTstrict _) = True+strictNT _ = False++ntContext2Pair (NTcontext c a) = (c,a)++contextNT (NTcontext _ _) = True+contextNT  _ = False+++{- Determine the type constructors that occur in the given type -}+consNT :: NT -> [Id]++consNT nt =+  consNT' nt []+ where+  consNT' (NTstrict nt) r = consNT' nt r+  consNT' (NTapp t1 t2) r = consNT' t1 (consNT' t2 r)+  consNT' (NTcons c _ nts) r = c:foldr consNT' r nts+  consNT' _ r = r++{- +Same as consNT except that constructor from NTcontext goes also into result.+used only in module Export +-}+useNT :: NT -> [Id]++useNT (NTany  a)    = []+useNT (NTvar  a _)  = []+useNT (NTexist a _) = []+useNT (NTstrict t) = useNT t+useNT (NTapp t1 t2) =  useNT t1 ++ useNT t2+useNT (NTcons a _ tas) =  a:concatMap useNT tas+useNT (NTcontext c v) =  [c]+++{- Determine type variables that occur in given type. -}+freeNT :: NT -> [Id]++freeNT (NTany  a)    = [a]+freeNT (NTvar  a _)  = [a]+freeNT (NTexist a _) = [a]+freeNT (NTstrict t) = freeNT t+freeNT (NTapp t1 t2) =  freeNT t1 ++ freeNT t2+freeNT (NTcons a _ tas) =  concat (map freeNT tas)+++{- +Exchange type variables according to given mapping in given type. +(not existentially quantified vars.+-}+freshNT :: (Id -> Id) -> NT -> NT++freshNT tv (NTany  a)   = NTany (tv a)+freshNT tv (NTvar  a k) = NTvar (tv a) k+freshNT tv t@(NTexist  a _) = t+freshNT tv (NTstrict t) = {- NTstrict -}  (freshNT tv t)+freshNT tv (NTapp t1 t2) =  NTapp (freshNT tv t1) (freshNT tv t2)+freshNT tv (NTcons a k tas) =  NTcons a k (map (freshNT tv) tas)+freshNT tv (NTcontext c v) =  NTcontext c (tv v)++anyNT av t@(NTany  a)    = t+anyNT av t@(NTvar  a _)  = if a `elem` av then NTany a else t+anyNT av t@(NTexist a _) = t+anyNT av (NTstrict t) = NTstrict (anyNT av t)+anyNT av (NTapp t1 t2) =  NTapp (anyNT av t1) (anyNT av t2)+anyNT av (NTcons a k tas) =  NTcons a k (map (anyNT av) tas)++polyNT fv t@(NTany  a) = if a `elem` fv then mkNTvar a else t+polyNT fv t@(NTvar  a _) = t+polyNT fv t@(NTexist a _) = t+polyNT fv (NTstrict t) = NTstrict (polyNT fv t)+polyNT fv (NTapp t1 t2) = NTapp (polyNT fv t1) (polyNT fv t2)+polyNT fv (NTcons a k tas) = NTcons a k (map (polyNT fv) tas)++transCtxs tv tc ctxs = map (\(c,v) -> (tc c,tv v)) ctxs ++++{- Show function for NT, parameterised by show functions for +constructors/class names and for type variables.+-}+strNT :: (Int -> String) -> (Int -> String) -> NT -> String++strNT c p (NTany  a) = p a++"#"+strNT c p (NTvar  a _) = p a+strNT c p (NTexist a _) = p a++"?"+strNT c p (NTstrict t) = "!" ++ strNT c p t+strNT c p (NTapp t1 t2) = "(" ++ strNT c p t1  ++ " " ++ strNT c p t2 ++ ")"+strNT c p (NTcons a _ []) = c a+strNT c p (NTcons a _ tas) = "(" ++ c a ++ " " ++ mixSpace (map (strNT c p) tas) ++ ")"+strNT c p (NTcontext a v) = "(" ++ c a ++ " " ++ p a ++ ") => "++instance Show NT where+  showsPrec d nt = ((strNT show (show ::(Int->String)) nt)++)++strTVar v = let cv =  toEnum (v + fromEnum 'a')+            in if 'a' <= cv && cv <= 'z'+	       then [cv]+	       else toEnum (v`mod`26 + fromEnum 'a'):'_':show (v`div`26)+	--     else '_':show v+++strCtxs ::  [(Int,Int)] -> String+strCtxs [] = ""+strCtxs ctxs = "(" ++ mixComma (map ( \ (c,v) -> show c ++ ' ':strTVar v ) ctxs) ++ ") => "++strTVs [] = ""+strTVs tvs =  "\\/ " ++ mixSpace (map strTVar tvs) ++ " . "++strTVarsCtxsNTs tvs ctxs [] =  strTVs tvs ++ strCtxs ctxs ++ " -"+strTVarsCtxsNTs tvs ctxs nts =  +  strTVs tvs ++ strCtxs ctxs ++ mix " -> " (map (strNT show strTVar) nts)+++sndNTvar (c,v) = (c,mkNTvar v) -- used for ctxs		*** KIND??+++anyVarNT :: NT -> Maybe Id+anyVarNT (NTany tvn) = Just tvn+anyVarNT (NTvar tvn _) = Just tvn+anyVarNT _ = Nothing
+ compiler98/Nice.hs view
@@ -0,0 +1,130 @@+{- ---------------------------------------------------------------------------+Converts internal types (NewType) into a nice printable string+-}+module Nice (fixTid, mkAL, mkALNT+	, niceCtxs, niceField, niceInt, niceNT+	, niceNewType, niceTid, showsOp, showsVar+	)  where++import NT+import IntState+import Extra(dropJust,mixComma,mixSpace,assocDef)+import SysDeps(PackedString)+import TokenId+import Id(Id)++niceNT :: Maybe PackedString  -- module qualifier+        -> IntState           -- symboltable needed for names of ids+        -> [(Id,String)]      -- renaming mapping for type variables+        -> NT                 -- the type to be converted+        -> String++niceNT _ state al (NTany  a) = assocDef al ('?':show a ++ "?") a+niceNT _ state al (NTvar  a _) = assocDef al ('?':show a ++ "?") a+niceNT _ state al (NTexist a _) = assocDef al ('?':show a ++ "?") a+niceNT m state al (NTstrict t) = "!" ++ niceNT m state al t+niceNT m state al (NTapp t1 t2) = +   '(':  niceNT m state al t1 ++ ' ': niceNT m state al t2 ++ ")"+niceNT m state al (NTcons a _ []) = niceInt m state a ""+niceNT m state al (NTcons a _ tas) =+        case (tidI . dropJust .  lookupIS state) a of+	  TupleId n | n > length tas -> '(':'(':replicate (n-1) ',' ++") "+                                        ++mixSpace (map (niceNT m state al) tas)+                                        ++ ")"+	  TupleId _ -> '(' : mixComma (map (niceNT m state al) tas) ++ ")"+	  v | v == t_Arrow ->+		case tas of+		 [] -> "(->)"+		 [t1] -> "( (->) " ++ niceNT m state al t1 ++ ")"+		 [t1,t2] -> '(':niceNT m state al t1 ++ " -> " ++ niceNT m state al t2++")"+	  v | v == t_List  -> "[" ++ (case tas of [] -> ""; [t] -> niceNT m state al t) ++ "]"+	  v -> '(': show (fixTid (mrpsIS state) v) ++ ' ': mixSpace (map (niceNT m state al) tas) ++ ")"+niceNT m state al (NTcontext c a) =+        case (tidI . dropJust .  lookupIS state) c of+	  TupleId _ -> '(' : niceNT m state al (mkNTvar a) ++ ")"+	  v -> '(': show (fixTid (mrpsIS state) v) ++ ' ': niceNT m state al (mkNTvar a) ++ ")"+++niceCtxs :: Eq a +         => Maybe PackedString +         -> IntState +         -> [(a,String)] +         -> [(Id,a)] +         -> String++niceCtxs mmrps state al [] = ""+niceCtxs mmrps state al ctxs = "(" ++ mixComma (map ( \ (c,v) -> niceInt mmrps state c  (' ':assocDef al (error "niceCtx") v)) ctxs) ++ ") => "+++niceInt :: Maybe PackedString -> IntState -> Id -> ShowS++niceInt Nothing state i     = (niceInfo (mrpsIS state) . dropJust . lookupIS state) i+niceInt (Just mrps) state i = (niceInfo  mrps          . dropJust . lookupIS state) i+++niceTid :: IntState -> TokenId -> ShowS++niceTid state tid = (showsVar . fixTid (mrpsIS state)) tid+++niceInfo :: PackedString -> Info -> ShowS++niceInfo mrps info = (showsVar . fixTid mrps . tidI) info+++{- removes module name from qualified token if it is the current module name -}+fixTid :: PackedString -- name of current module+       -> TokenId +       -> TokenId++fixTid mrps (Qualified tid n) | tid == mrps = Visible n+fixTid mrps v = v+++{- produces renaming mapping for the free variables of given type -}+mkALNT :: NT -> [(Id,String)]++mkALNT = mkAL . freeNT+++{- produces renaming mapping for given type ids -}+mkAL :: [a] -> [(a,String)]++mkAL tvs = +   let tvars = map (:[]) ['a'..'z'] ++ map (++"'") tvars+   in zip tvs tvars+++niceNewType :: IntState -> NewType -> String++niceNewType state (NewType free exist ctx nts) =+    let+      al = mkAL free ++ zip (map snd ctx) (map (('_':).(:[])) ['a'..'z']) -- a-z is too short!+    in niceCtxs Nothing state al ctx ++ mixSpace (map (niceNT Nothing state al) nts)+++showsOp :: TokenId -> ShowS++showsOp tid =+	if isTidOp tid +	then shows tid+	else showChar '`' . shows tid . showChar '`'+++showsVar :: TokenId -> ShowS++showsVar tid =+	if isTidOp tid +	then showChar '(' . shows tid . showChar ')'+	else shows tid+++niceField :: IntState +          -> [(Id,String)]  -- renaming mapping for type variables+          -> (Maybe Id,NT)  -- (possible field id, its type)+          -> String++niceField state al (Just i,nt) = (showChar '{' . shows (fixTid (mrpsIS state) (tidIS state i)) . showString " :: ")+				 (niceNT Nothing state al nt ++ "}")+niceField state al (Nothing,nt) =+   niceNT Nothing state al nt
+ compiler98/OsOnly.hs view
@@ -0,0 +1,121 @@+-- operating specific processing of filenames and paths+module OsOnly+  (isPrelude+  , fixImportNames, fixRootDir, fixDependFile, fixTypeFile, fixObjectFile+  , fixHatAuxFile,fixHatTransDir,fixHatTransFile,fixHatFileBase+  , hierarchical+  ) where++import Data.Char (isUpper)++isPrelude str = {-take (7::Int)-} str == "Prelude"++-- from complete filename determine path and pure filename without extension+fixRootDir :: Bool -> String -> (String,String)+fixRootDir isUnix s =+ let rs = reverse s+ in+  if isUnix+  then+    case span (/='/') (stripUnix rs) of+      (rf,rr) -> (reverse rr,reverse rf)+  else+    case span (/='.') rs of+      (rf,rr) -> (reverse (stripRiscos rr),reverse rf)+ where+   stripUnix ('s':'h':'l':'.':r) = r+   stripUnix ('s':'h':    '.':r) = r+   stripUnix                  r  = r++   stripRiscos ('.':'s':'h':'l':rr) = rr+   stripRiscos ('.':'s':'h':    rr) = rr+   stripRiscos                  rr  = rr++fixImportNames :: Bool -> String -> String -> [String] -> [String]+fixImportNames isUnix suffix file rootdirs =+  map (\dir-> fixDir isUnix dir ++ (fixFile isUnix file suffix)) rootdirs+++-- prepare path so that it can be concatenated with filename+fixDir :: Bool -> String -> String+fixDir isUnix dir+  | isUnix    = case (dir,last dir) of+                    ("",_)  -> ""+                    (_,'/') -> dir+                    (_,_)   -> dir ++ "/"+  | otherwise = dir++fixTypeFile   isUnix rootdir s = rootdir ++ fixFile isUnix s "hi"+fixObjectFile isUnix rootdir s = rootdir ++ fixFile isUnix s "hc"+fixDependFile isUnix rootdir s = rootdir ++ fixFile isUnix s "dep"+fixHatAuxFile isUnix rootdir s = rootdir ++ fixFile isUnix s "hx"+fixHatFileBase isUnix rootdir s = rootdir ++ s ++fixHatTransDir isUnix rootdir =+  if null rootdir then "Hat"+  else if hierarchical rootdir then "Hat/"++init rootdir+       else rootdir++"Hat"++fixHatTransFile isUnix rootdir s =+  fixHatTransDir isUnix rootdir ++"/"++ fixFile isUnix s "hs"++-- add extension to file+fixFile :: Bool -> String -> String -> String+fixFile isUnix file suf =+{-+  let file =  if isPrelude s+              then case drop (7::Int) s of [] -> s ; r  -> r+              else s+  in+-}+    if isUnix+      then toUnixPath file ++ '.':suf+      else suf ++ '.':maxTen file++toUnixPath :: String -> String+toUnixPath = map (\c-> if (c=='.') then '/' else c)++{- Does a directory name look like a hierarchical module namespace? -}+hierarchical :: String -> Bool+hierarchical dir =+    let (a,b) = break (=='/') dir in+    case b of+      "" -> True+      _  -> case a of+              ""    -> hierarchical (tail b)+              "."   -> False+              ".."  -> False+              (x:_) -> isUpper x && hierarchical (tail b)++-- obscure filename compression needed only for RiscOs:++maxTen file = let tolong =  length file - 10+              in if tolong <= 0 then file+                 else take (10::Int) (strip tolong file)++strip 0 xs = xs+strip n [] = []+strip n (x:xs) = if isVowel x then strip (n-1) xs else x: strip n xs++isVowel 'a' = True+isVowel 'e' = True+isVowel 'i' = True+isVowel 'o' = True+isVowel 'u' = True+isVowel 'y' = True+isVowel '\xe1' = True   -- aa+isVowel '\xe0' = True   -- ae+isVowel '\xf0' = True   -- oe+isVowel 'A' = True+isVowel 'E' = True+isVowel 'I' = True+isVowel 'O' = True+isVowel 'U' = True+isVowel 'Y' = True+isVowel '\xc5' = True   -- AA+isVowel '\xc4' = True   -- AE+isVowel '\xd4' = True   -- OE+isVowel _   = False+++
+ compiler98/Parse.hs view
@@ -0,0 +1,428 @@+{- ---------------------------------------------------------------------------+Parser for Haskell 98 Syntax+-}+module Parse(parseProg) where++import Extra(pair,noPos,strace,strPos,mergePos)+import Lex+import Lexical(PosToken)+import Syntax+import MkSyntax	( mkAppExp, mkCase, mkDeclClass+	, mkDeclFun, mkDeclPat, mkDeclPatFun, mkEnumFrom+	, mkEnumThenFrom, mkEnumToFrom, mkEnumToThenFrom+	, mkExpListComp, mkIf, mkInfixList, mkExpList+        , mkLambda, mkLet, mkDo, mkFieldExp+	, mkParExp, mkPatNplusK -- , mkParLhs+	)+import Parse2+import ParseLib+import ParseLex+import SyntaxPos+import TokenId (t_nplusk,t_Arrow)++optSemi = () `parseChk` semi+                `orelse`+           parse ()+++parseProg :: Parser (Module TokenId) [PosToken] a+parseProg = {- many parsePragma `revChk` -} (parseModule `chkCut` eof)+++parseModule :: Parser (Module TokenId) [PosToken] a+parseModule =+    (uncurry Module) `parseChk` lit L_module `apCut` bigModId `ap` parseExports+                 `chk` lit L_where `chk` lcurl+                         `apCut` parseImpDecls+                         `apCut` parseFixDecls+                         `apCut` parseTopDecls+                `chk` optSemi `chk` rcurl+++parseTopDecls :: Parser (Decls TokenId) [PosToken] a+parseTopDecls =+  semi `revChk` parseTopDecls+    `orelse`+  DeclsParse `parseAp` manysSep semi parseTopDecl+++parseTopDecl :: Parser (Decl TokenId) [PosToken] a+parseTopDecl =+  cases [+  (L_type, \pos -> DeclType `parseAp` parseSimple `chk` equal `ap` parseType),+  (L_newtype, \pos -> +    DeclData Nothing `parseAp` parseContexts `ap` parseSimple `chk` +      equal `apCut` ( (:[]) `parseAp` parseConstr) `apCut` parseDeriving),+  (L_data, \pos -> +      (\ (pos,conid) size -> DeclDataPrim pos conid size) `parseChk` +        k_primitive `ap` conid `chk` equal `apCut` intPrim+    `orelse`+      (DeclData . Just) `parseAp` unboxed `ap` parseContexts `ap` +        parseSimple `chk` equal `apCut`+        someSep pipe parseConstr `apCut` parseDeriving+    `orelse`+      (\ simpl -> DeclData (Just False) [] simpl [] []) `parseAp` parseSimple ),+  (L_class, \pos -> +    mkDeclClass `parseAp` parseContexts `ap` aconid `ap` some avarid `ap` +      parseFunDeps `ap`+      (id `parseChk` lit L_where `chk` lcurl `ap` parseCDecls `chk` rcurl+       `orelse` +       parse (DeclsParse [])+      )), +  (L_instance, \pos->  +    (\ctx (pos',cls) -> DeclInstance pos' ctx cls) `parseAp` +      parseContexts `ap` aconid `ap` some parseInst `ap` +      (lit L_where `revChk` lcurl `revChk` parseValdefs `chk` rcurl+       `orelse`+       parse (DeclsParse [])+      )),+  (L_default, \pos -> +    DeclDefault `parseChk` lpar `apCut` +      manySep comma parseType `chk` rpar+    `orelse`+    (\x->DeclDefault [x]) `parseAp` parseType)+  ]+  (uncurry DeclPrimitive `parseAp` varid `chk` k_primitive `apCut` +     intPrim `chk` coloncolon `ap` parseType+   `orelse`+   parseForeign+   `orelse`+   parseDecl)+++parseFunDeps :: Parser [FunDep TokenId] [PosToken] a+parseFunDeps =+  pipe `revChk` someSep comma parseFunDep+    `orelse`+  parse []++parseFunDep :: Parser (FunDep TokenId) [PosToken] a+parseFunDep =+    (:->:) `parseAp` parseTyVars `chk` rarrow `ap` parseTyVars+  where+    parseTyVars :: Parser [TokenId] [PosToken] a+    parseTyVars =+        map snd `parseAp` some avarid+     -- map snd `parseAp` (lpar `revChk` someSep comma avarid `chk` rpar)+     --   `orelse`+     -- ((:[]) . snd) `parseAp` varid++parseForeign :: Parser (Decl TokenId) [PosToken] a+parseForeign =+  k_foreign `revAp`+    ((k_import `revChk` +        ((\(_,conv) (_,tf) (_,LitString _ str) (_,v) t p -> +            DeclForeignImp (mergePos p (getPos t)) conv str v +              (calcArity t) tf t v)+        `parseAp` callconv `ap` safety `ap` entity `ap` varid `chk` +        coloncolon `apCut` parseType))+    `orelse`+    (k_export `revChk`+      ((\(_,conv) (_,LitString _ str) (_,v) t p-> +          DeclForeignExp (mergePos p (getPos t)) conv str v t)+      `parseAp` callconv `ap` entity `apCut` varid `chk` coloncolon +      `ap` parseType))+    `orelse`+    (k_import `revChk`	-- old syntax, will be removed in the future+        ((\(_,conv) (_,LitString _ str) (_,tf) (_,v) t p -> +            let p' = mergePos p (getPos t) in+            strace ("Deprecated FFI syntax used at "++strPos p') $+            DeclForeignImp p' conv str v (calcArity t) tf t v)+        `parseAp` (callconv `orelse` is C) `ap` entity `ap`+        safety `apCut` varid `chk` coloncolon `ap` parseType))+ -- `orelse`+ --   (k_cast `revChk` + --     ((\(p,v) t-> DeclForeignImp p Cast "" v (calcArity t) Safe t v)+ --     `parseAp` varid `chk` coloncolon `ap` parseType))+     )+  where+  callconv = (k_ccall `revChk` is C)+               `orelse` +             (k_cast `revChk` is Cast)+               `orelse`+             (k_noproto `revChk` is Noproto)+               `orelse`+             (k_haskellcall `revChk` is Haskell)+               `orelse` +             (k_stdcall `revChk` is (Other "stdcall"))+               `orelse` +             (k_cplusplus `revChk` is (Other "cplusplus"))+               `orelse` +             (k_dotnet `revChk` is (Other "dotnet"))+               `orelse` +             (k_jvm `revChk` is (Other "jvm"))+          --   `orelse` +          -- (is C)  -- previously the default, now the name is mandatory+  is v     = parse (noPos,v)+  entity   = string `orelse` is (LitString UnBoxed "")+  safety   = (k_unsafe `revChk` is Unsafe)+               `orelse`+             (k_safe `revChk` is Safe)+               `orelse`+             (is Safe) -- default is Safe+  calcArity (TypeCons p c ts) | c == t_Arrow  = 1 + calcArity (ts!!1)+  calcArity _                 | otherwise     = 0+++parseVarsType :: Parser (Decl TokenId) [PosToken] a+parseVarsType =+  DeclVarsType `parseAp` someSep comma varid `chk` coloncolon `ap` +    parseContexts `ap` parseType++{-+parseNewConstr =+    (\ (pos,op) a ->  [Constr pos op [(Nothing,a)]]) `parseAp` conid `ap` parseInst+-}+++-- parseCSigns = DeclsParse `parseAp` manySep semi parseCSign+-- parseCSign = parseVarsType++parseCDecls :: Parser (Decls TokenId) [PosToken] a +parseCDecls = DeclsParse `parseAp` (manysSep semi parseCDecl)	-- H98 added++parseCDecl :: Parser (Decl TokenId) [PosToken] a+parseCDecl = parseVarsType `orelse` parseValdef+		 `orelse` (DeclFixity `parseAp` parseFixDecl)+++parseValdefs :: Parser (Decls TokenId) [PosToken] a+parseValdefs =+  semi `revChk` parseValdefs+  `orelse`+  DeclsParse `parseAp` manysSep semi parseValdef+++parseValdef :: Parser (Decl TokenId) [PosToken] a+parseValdef =+ mkDeclPat `parseAp` varid `ap` anyop `ap` parsePat `ap` +   parseRhs equal `apCut` parseWhere+ `orelse` + mkDeclFun `parseAp` varid `ap` parsePats `ap` parseRhs equal `apCut` +   parseWhere+ `orelse` + mkDeclPatFun `parseAp` parseAlt equal+++parseWhere :: Parser (Decls TokenId) [PosToken] a+parseWhere =+    lit L_where `revChk` lcurl `revChk` parseDecls `chk` rcurl+        `orelse`+    parse (DeclsParse [])+++parseDecls = DeclsParse `parseAp` (manysSep semi parseDecl)++parseDecl =+    parseVarsType+        `orelse`+    parseValdef+        `orelse`			-- added in H98+    DeclFixity `parseAp` parseFixDecl	-- added in H98+ {-	`orelse`+    parsePragma				-- added by MW, Sept 2000+  -}+++parseExp :: Parser (Exp TokenId) [PosToken] a+parseExp =+    parseExp0 `revAp` parseExpType++parseExpType :: Parser (Exp TokenId -> Exp TokenId) [PosToken] a+parseExpType =+      (\pos ctx t e-> ExpType (mergePos pos (getPos t)) e ctx t) +              `parseAp` coloncolon `apCut`+              parseContexts `ap` parseType+        `orelse`+      parse id++parseExp0 :: Parser (Exp TokenId) [PosToken] a+parseExp0 = mkInfixList `parseAp` some (anyop `orelse` parseExp10)++parseStmt =+   (lit L_let `into` \_-> lcurl `into` \_-> parseDecls `into`+                 \decls-> rcurl `into` \_->+	((lit L_in `into` \_-> parseExp `into`+              \exp-> parse (StmtExp (ExpLet +                            (mergePos (getPos decls) (getPos exp)) decls exp)))+	    `orelse`+	  parse (StmtLet decls)))+	`orelse`+   StmtBind `parseAp` parsePat `chk` larrow `apCut` parseExp+	`orelse`+   StmtExp `parseAp` parseExp++parseExp10 =+    cases +        [(L_Lambda,\pos -> (mkLambda pos) +           `parseAp` parsePats `chk` rarrow `apCut` parseExp),+         (L_let,   \pos -> (mkLet pos)+           `parseChk` lcurl `ap` parseDecls +           `chk` optSemi `chk` rcurl+           `chk` lit L_in `ap` parseExp),+         (L_do,    \pos -> (mkDo pos)+           `parseChk` lcurl `ap` somesSep semi parseStmt+           `chk` optSemi `chk` rcurl),+         (L_if,    \pos -> (mkIf pos) +           `parseAp` parseExp +           `chk` lit L_then `ap` parseExp+           `chk` lit L_else `ap` parseExp),+         (L_case,  \pos -> (mkCase pos) +           `parseAp` parseExp `chk` lit L_of+           `chk` lcurl `ap` (somesSep semi (parseAlt rarrow)) +           `chk` optSemi `chk` rcurl)]+         parseFExp++parseFExp  = mkAppExp `parseAp` some parseAExpR1++parseAExpR1 =+  parseAExp `into` parseAExpR++parseAExpR exp = +   (ExpRecord exp `parseChk` lcurl `ap` manySep comma parseFieldExp `chk` rcurl)            `into` parseAExpR+	`orelse`+   parse exp++parseAExp = +    aanyid+        `orelse`+    cases +         [(L_LBRACK, \pos -> parseBrackExp0 pos),+          (L_LPAR,   \pos -> (mkParExp pos) `parseAp` manySep comma parseExp+                                            `ap` rpar)]+    (uncurry ExpLit `parseAp`+            (integer `orelse` rational `orelse` char `orelse` string))+++parseFieldExp =+    varid `into` (\(pos,ident)-> (mkFieldExp pos ident `parseChk` equal+                                                       `ap` parseExp)+					`orelse`		-- H98 removes+				 parse (FieldPun pos ident)	-- H98 removes+                 )++parseBrackExp0 pos =                -- found '['+    (mkExpList pos []) `parseAp` rbrack+        `orelse`+    parseExp `revAp` parseBrackExp1 pos++parseBrackExp1 pos =                -- found '[e'+    (\posr e -> mkExpList pos [e] posr) `parseAp` rbrack+        `orelse`+    mkEnumFrom pos `parseChk` dotdot `chk` rbrack+        `orelse`+    mkExpListComp pos `parseChk` pipe `ap` somesSep comma parseQual `chk` rbrack+        `orelse`+    mkEnumToFrom pos `parseChk` dotdot `ap` parseExp `chk` rbrack+        `orelse`+    comma `revChk` (parseExp `revAp` parseBrackExp2 pos)++parseBrackExp2 pos =                -- found '[e,e'+    (\posr e2 e1 -> mkExpList pos [e1,e2] posr) `parseAp` rbrack+        `orelse`+    mkEnumThenFrom pos `parseChk` dotdot `chk` rbrack+        `orelse`+    mkEnumToThenFrom pos `parseChk` dotdot `ap` parseExp `chk` rbrack+        `orelse`+    (\es posr e2 e1 -> mkExpList pos (e1:e2:es) posr) `parseChk` comma+                                          `ap` manySep comma parseExp+                                          `ap` rbrack++parseQual =+   (lit L_let `into` \_-> lcurl `into` \_-> parseDecls `into`+                 \decls-> rcurl `into` \ _ ->+	((lit L_in `into` \_-> parseExp `into` \exp->+                        parse (QualExp (ExpLet (getPos decls) decls exp)))+		`orelse`+	 parse (QualLet decls)))+	`orelse`+    QualPatExp `parseAp` parsePat `chk` larrow `apCut` parseExp+        `orelse`+    QualExp `parseAp` parseExp++parseAlt del =+    Alt `parseAp` parsePat `ap` parseRhs del `apCut` parseWhere+++parseRhs :: Parser Pos [PosToken] a -> Parser (Rhs TokenId) [PosToken] a+parseRhs del =+    Unguarded `parseChk` del `apCut` parseExp+        `orelse`+    Guarded `parseAp` some (parseGdExp del)+++parseGdExp :: Parser Pos [PosToken] a  +              -> Parser (Exp TokenId, Exp TokenId) [PosToken] a+parseGdExp del =+    pair `parseChk` pipe `apCut` parseExp `chk` del `apCut` parseExp+++parsePats = some parseAPat+++-- Pat can not contain cut! It brakes parseStmt if it does.++manySafe p = someSafe p `orelse` parse []+someSafe p = (:) `parseAp` p `ap` manySafe p++manySepSafe' s p = s `revChk` someSepSafe s p+                 `orelse`+               parse []+manySepSafe s p = someSepSafe s p `orelse` parse []+someSepSafe s p = (:) `parseAp` p `apCut` manySepSafe' s p++parsePat =+    mkPatNplusK `parseAp` varid `chk` literal (L_AVAROP t_nplusk) `ap` integer+        `orelse`+    parsePat0++parsePat0 = mkInfixList `parseAp` someSafe (parseOpPat `orelse` parseFPat)++parseOpPat = anyop++parseFPat =+    (\(pos,c) args -> mkAppExp (ExpCon pos c:args))+                      `parseAp` conid `ap` some parseAPat+        `orelse`+    parseAPat++parseAPat = parseAPat2 `into` parseAPat1++parseFieldPat =+    varid `into` (\(pos,ident)-> mkFieldExp pos ident `parseChk` equal+                                                    `ap` parsePat+					`orelse`		-- H98 removes+				   parse (FieldPun pos ident)	-- H98 removes+                 )++parseAPat1 exp =+   (ExpRecord exp `parseChk` lcurl `ap` manySepSafe comma parseFieldPat+                  `chk` rcurl) `into` parseAPat1+	`orelse`+   parse exp+  ++parseAPat2 =+    varid `revAp` ((\e (pos,i) -> let p = mergePos pos (getPos e) +                                  in p `seq` PatAs pos i e) +                      `parseChk` lit L_At `ap` parseAPat+                        `orelse`+                    parse (\ (pos,e) -> ExpVar pos e)+                  )+        `orelse`+    (\(pos,e) -> ExpCon pos e) `parseAp` aconid+        `orelse`+    PatWildcard `parseAp` lit L_Underscore+        `orelse`+    mkParExp `parseAp` lpar `ap` manySepSafe comma parsePat `ap` rpar+        `orelse`+    mkExpList `parseAp` lbrack `ap` manySepSafe comma parsePat `ap` rbrack+        `orelse`+    PatIrrefutable `parseAp` lit L_Tidle `ap` parseAPat+        `orelse`+    (uncurry ExpLit `parseAp`+         (integer `orelse` rational `orelse` char `orelse` string))+ --     `orelse`+ -- mkParLhs `parseAp` lpar `ap` parsePat0 `chk` rpar `ap` someSafe parseAPat++{- End Module Parse ---------------------------------------------------------}
+ compiler98/Parse2.hs view
@@ -0,0 +1,258 @@+module Parse2+  ( parseConstr,  parseContexts, parseDeriving, parseFixDecls+  , parseFixDecl, parseImpDecls, parseInst,     parseSimple, parseType+  , parseExports, parseStrict,   parsePragma+  , bigModId+  ) where++import Extra(pair,triple)+import Lex hiding (TokenId)+import Syntax hiding (TokenId)+import Lexical (PosToken)+import MkSyntax+import ParseLib+import ParseLex+import SyntaxPos+import TokenId(t_Arrow,TokenId(..))+import SysDeps (packString,unpackPS)++parseExports =+    Just `parseChk` lpar `apCut` manySep comma parseExport `chk` +      optional comma `chk` rpar+        `orelse`+    parse Nothing `chk` (lit (L_ACONID (TupleId 0))+                            `orelse`+                         lit (L_ACONID (TupleId 2)))+        `orelse`+    parse (Just [])++parseExport =+    (uncurry ExportModid) `parseChk` lit L_module `apCut` bigModId	-- 1.3+        `orelse`+ -- (uncurry ExportModid) `parseAp` aconid `chk` dotdot			-- 1.2+ --     `orelse`+    (\e -> ExportEntity (getPos e) e) `parseAp` parseEntity++parseImpDecls =+    manysSep semi parseImpDecl++parseImpDecl =+    Importas `parseChk` lit L_import `ap` bigModId+                    `chk` k_as `ap` bigModId `ap` parseImpSpec   -- added in H98+	`orelse`+    importas `parseChk` lit L_import `ap` aconid `ap` parseImpSpec+	`orelse`+    ImportQas `parseChk` lit L_import `chk` k_qualified `ap` bigModId+                    `chk` k_as `ap` bigModId `ap` parseImpSpec+	`orelse`+    importQas `parseChk` lit L_import `chk` k_qualified+                    `ap` aconid `ap` parseImpSpec     -- impSpec is FAKE+  where+    importas  m@(p,Visible _)     s = Import m s+    importas  m@(p,Qualified a b) s = Import (deQualify m) s+ -- importas  m@(p,Qualified a b) s = Importas (deQualify m) (p,Visible b) s+    importQas m@(p,Visible _)     s = ImportQ m s+    importQas m@(p,Qualified a b) s = ImportQ (deQualify m) s+ -- importQas m@(p,Qualified a b) s = ImportQas (deQualify m) (p,Visible b) s++bigModId = deQualify `parseAp` aconid++deQualify m@(pos,Visible _)     = m+deQualify   (pos,Qualified a b) = (pos, (Visible . packString . concat)+                                                  [unpackPS b,".",unpackPS a])+++parseImpSpec =+    (NoHiding []) `parseChk` (k_unit `orelse` lit (L_ACONID (TupleId 2)))+			-- fix for  import Module()  and  import Module (,)+        `orelse`+    NoHiding `parseChk` lpar `apCut` manySep comma parseEntity `chk` +      optional comma `chk` rpar+        `orelse`+    Hiding `parseChk` k_hiding `chk` lpar `apCut`+      manySep comma parseEntity `chk` optional comma `chk` rpar+        `orelse`+    (Hiding []) `parseChk` k_hiding `chk` (k_unit `orelse`+                                           lit (L_ACONID (TupleId 2)))+			-- fix for  hiding ()  and  hiding (,)+        `orelse`+    parse (Hiding [])++parseEntity =+    (uncurry EntityConClsAll) `parseAp` aconid `chk`+				lpar `chk` dotdot `chk` rpar+	`orelse`+    (\(pos,x) -> EntityConClsSome pos x []) `parseAp` aconid `chk` tuple0+        `orelse`+    (uncurry EntityConClsSome) `parseAp` aconid `chk`+		lpar `ap` (manySep comma (conid `orelse` varid)) `chk` rpar+	`orelse`+    (uncurry EntityConClsSome) `parseAp` aconid `ap` (parse []) +	`orelse`+    (uncurry EntityVar) `parseAp` varid+++parseFixDecls =+    semi `revChk` parseFixDecls+        `orelse`+    manysSep semi parseFixDecl++defint d =+    intPrim+        `orelse`+    parse d++parseInfix = InfixL `parseChk` lit L_infixl+               `orelse`+             InfixR `parseChk` lit L_infixr+               `orelse`+             Infix  `parseChk` lit L_infix++parseFixDecl =+        triple `parseAp` parseInfix `ap` defint 9 `ap` someSep comma parseFixId+               `orelse`+        k_prefix `into` \ _ -> varid `into` \ (p,v) -> defint 9 `into` \ l -> parseFixId `into` \ fid ->+	parse (InfixPre v,l,[fid])++parseFixId = +        (uncurry FixCon) `parseAp` conop+	    `orelse`+        (uncurry FixVar) `parseAp` varop+++parseType = +    parseBType  `into` parseCType+		`into` \ t1 -> (+		    (\ pos t2 -> TypeCons pos t_Arrow [t1,t2]) `parseAp` rarrow `apCut` parseType+			`orelse`+		    parse t1)++parseCType t1 = +    parseAType `into` (\ t2 -> parseCType (TypeApp t1 t2))+	`orelse`+    parse t1++parseBType  = +    ( \ (pos,c) ts -> TypeCons pos c ts) `parseAp` conid `ap` some parseAType+        `orelse`+    parseAType++parseAType = +    (uncurry TypeVar) `parseAp` varid+        `orelse`+    (\(pos,c) -> TypeCons pos c []) `parseAp` conid+        `orelse`+    mkParType `parseAp` lpar `apCut` manySep comma parseType `chk` rpar+        `orelse`+    mkTypeList `parseAp` lbrack `apCut` parseType `chk` rbrack+    ++parseContexts =+    lpar `revChk` manySep comma parseContext `chk` rpar `chk` impl+        `orelse`+    (:[]) `parseAp` parseContext `chk` impl+        `orelse`+    parse [] `chk` tuple0 `chk` impl+        `orelse`+    parse []++parseContext = +    (\ (pos,c) pt_t -> Context pos c pt_t)  `parseAp` conid `ap` some varid++parseSimple :: Parser (Simple TokenId) [PosToken] c+parseSimple =+    (uncurry Simple) `parseAp` conid `ap` many varid++parseConstr =+	(k_forall `revChk` some varid `into` \ free -> k_dot `revChk` parseConstr' free)+	  `orelse`+	parseConstr' []++parseConstr' free =+    (\a (pos,op) b -> (if null free +		       then Constr pos op [a,b]+		       else ConstrCtx free [] pos op [a,b]))+			 `parseAp` parseOneFieldType `ap` conop `ap` parseOneFieldType+        `orelse`+    (\ctxs (pos,op) a ->+	case ctxs of+	   [] ->  (if null free +		   then Constr            pos op (concat a)+		   else ConstrCtx free [] pos op (concat a))+           _  ->  ConstrCtx free ctxs pos op (concat a)) `parseAp` parseContexts + 				                         `ap` conid `ap` many parseManyFieldType++parseOneFieldType =+     (\ field typ -> (Just [field],typ)) `parseChk` lcurl `apCut` varid `chk` coloncolon `ap` parseSBType `chk` rcurl +	`orelse`+     (pair Nothing) `parseAp` parseSBType+++parseManyFieldType =+     lcurl `into` (\ _ -> manySep comma parseManyFieldType' `chk` rcurl)  -- { v1,...,v2::typeN , ...  w1,...,wN::typeN } +	`orelse`+     ((:[]).pair Nothing) `parseAp` (parseStrict parseAType)++parseManyFieldType' =+     (\ fields typ -> (Just fields,typ)) `parseAp` someSep comma varid `chk` coloncolon `ap`  parseSBType  -- v1,...,v2::typeN ++parseSBType =+    parseStrict parseType+	`orelse`+    parseType++parseStrict p =+  TypeStrict `parseAp` bang `ap` p+	`orelse`+  p++parseDeriving :: Parser [(Pos, TokenId)] [PosToken] b+parseDeriving =+    lit L_deriving `revChk` lpar `revChk` manySep comma conid `chk` rpar+        `orelse`+    parse [] `chk` lit L_deriving `chk` tuple0+        `orelse`+    (:[]) `parseChk` lit L_deriving `apCut` conid+        `orelse`+    parse []++{- The following code parses Haskell'98 instance heads.+-- H'98 is much more restrictive about the possible types in an instance+-- than MPTC with fundeps.+parseInst =+    (\ (p,c) -> TypeCons p c []) `parseAp` conid  -- type without arguments+        `orelse`+    lpar `revChk` parseInst' `chkCut` rpar	  -- type inside parenthesis+        `orelse`+    (\p (_,pat) -> mkInstList p pat) `parseAp` lbrack `apCut` varid+                                     `chk` rbrack -- the list type++parseInst' =+    lpar `revChk` parseInst' `chkCut` rpar	  -- useless extra parenthesis+	`orelse`+    varid `revAp` ((\pos (pa,a) (pb,b) ->+                        TypeCons pos t_Arrow [TypeVar pb b,TypeVar pa a])+                                             `parseAp` rarrow `apCut` varid+                      `orelse`+                   (\a b@(p,_) -> mkParInst p (b:a)) `parseChk` comma+                                             `apCut` someSep comma varid+                  )+        `orelse`+    mkAppInst `parseAp` conid `ap` many varid+        `orelse`+    (\pos-> TypeCons pos t_Arrow []) `parseAp` k_rarrow+        `orelse`+--    (TypeCons noPos (t_Tuple 0) []) `parseChk` lpar `chk` rpar+--        `orelse`+    parse (TypeCons noPos (t_Tuple 0) [])+-}+parseInst = parseAType++parsePragma =+     DeclIgnore "PRAGMA" `parseChk`  lannot `chk`+                                     many notRannot `chk` rannot++{- possible extension for when we want to use pragmas in nhc98 -}+--parsePragma =+--     DeclPragma `parseChk`  lannot `ap` conid `chk`+--                            ("" `parseChk` many notRannot) `chk` rannot
+ compiler98/ParseCore.hs view
@@ -0,0 +1,86 @@+module ParseCore(Pos,ParseError,ParseResult,ParseBad,ParseGood,Parser+               ,initError,initBad,initGood      -- Start values for parseError,parseBad, parseGood+	       ,parseit				-- entry for parsing+               ,parse,ap,chk,orelse,into        -- The core+               ,token                           -- parse terminal+               ,parseFail                       -- Failing parser+               ,maxError                        -- Keep "best" error message+               ) where++import Extra(noPos,Pos)++infixl 5 `ap`+infixl 5 `chk`+infixr 4 `orelse`++-- #if defined(__HASKELL98__)+-- #define EVAL(b)+-- #else+-- #define EVAL(b) (Eval b) =>+-- #endif++--- Define types+-- parameters:+-- i = input to be parsed+-- a = resulting syntax tree+-- c = other return value+type ParseError = (Pos,String,[String])+type ParseResult a i   = Either ParseError (a,i,ParseError) +type ParseBad    a i   =           ParseError -> ParseResult a i +type ParseGood   a i c = a -> i -> ParseError -> ParseResult c i+type Parser      a i c = ParseGood a i c -> ParseBad c i -> i -> ParseError ->  ParseResult c i ++--- start values+initError :: ParseError+initError = (noPos,"Hu?",["No error"])++initBad :: ParseBad a i+initBad = \err -> Left err++initGood :: ParseGood a i a+initGood = \res input err -> Right (res,input,err)++parseit :: Parser a i a -> i -> Either ParseError a++parseit p input = parseit' (p initGood initBad input initError)++parseit' (Left err) = Left err+parseit' (Right (a,_,_)) = Right a++--- The core+parse :: a -> Parser a i b+parse x = \good bad -> good x++ap :: Parser (a->b) i c -> Parser a i c -> Parser b i c+ap     x y = \good bad ->+                x       (\u -> y (\v -> let uv = u v in seq uv (good uv) ) bad)+                        bad++chk :: Parser b i c -> Parser a i c -> Parser b i c+chk     x y = \good bad ->+                x       (\u -> y (\_ -> good u) bad)+                        bad++into :: Parser a i c -> (a->Parser b i c) -> Parser b i c+into     x y = \good bad ->+                x       (\u -> y u good bad)+                        bad++orelse :: Parser a i b -> Parser a i b -> Parser a i b+x `orelse` y = \good bad input ->+        x good (y good bad input) input++token :: (Show b) => (Pos -> b -> Either String d) -> Parser d [(Pos,b,e,f)] h+token p = \good bad ((pos,t,_,_):input) err ->+        case p pos t of+                Right tt' -> good tt' input err+                Left  f   -> bad (maxError (pos,show t,[f]) err)++parseFail :: Parser a i b+parseFail = \good bad input err -> bad err+++maxError (a@(pa,ta,ma)) (b@(pb,tb,mb)) =+        if pa > pb then a+        else if pb > pa then b+             else (pa,ta,ma++mb)
+ compiler98/ParseLex.hs view
@@ -0,0 +1,160 @@+module ParseLex where++import Lex+import Lexical+import Syntax(Lit(..),Boxed(..),Exp(..))+import ParseLib+import TokenId(isUnit,t_Bang,tprefix,tas,tunboxed,tprimitive,t_Tuple+              ,tforall,tdot,t_Arrow+              ,t_foreign,t_export,t_ccall,t_haskell,t_unsafe,t_cast,t_noproto+              ,t_stdcall,t_cplusplus,t_dotnet,t_jvm,t_safe+              ,tinterface,thiding,tqualified)+++lit a = literal (a::Lex)++eof :: Parser Pos [PosToken] c+eof = lit L_EOF++unboxed = +  True `parseChk` k_unboxed +    `orelse`+  parse False+ +lbrack :: Parser Pos [PosToken] c+lbrack = lit L_LBRACK+rbrack :: Parser Pos [PosToken] c+rbrack = lit L_RBRACK+lpar :: Parser Pos [PosToken] c+lpar   = lit L_LPAR+rpar :: Parser Pos [PosToken] c+rpar   = lit L_RPAR+lannot :: Parser Pos [PosToken] c+lannot   = lit L_LANNOT+rannot :: Parser Pos [PosToken] c+rannot   = lit L_RANNOT++notRannot :: Parser Pos [PosToken] c+notRannot = token (\pos t -> case t of L_RANNOT -> Left "/= #-}";  x -> Right pos )++bang :: Parser Pos [PosToken] c+bang = lvarop t_Bang "!"++-- "special" identifiers which are *not* language keywords.+k_interface = lvarid tinterface "interface"+k_qualified = lvarid tqualified "qualified"+k_hiding = lvarid thiding "hiding"+k_as = lvarid tas "as"+k_unit = lconid (t_Tuple 0) "()"+k_primitive = lvarid tprimitive "primitive"+k_prefix = lvarid tprefix "prefix"+k_unboxed = lvarid tunboxed "unboxed"+k_forall = lvarid tforall "forall"+k_dot = lvarop tdot "dot"+k_rarrow = lvarop t_Arrow "->"++-- "special" identifiers for FFI which are not (all) language keywords.+k_foreign = lvarid t_foreign "foreign"+k_import = lit L_import+k_export = lvarid t_export "export"+k_ccall = lvarid t_ccall "ccall"+k_stdcall = lvarid t_stdcall "stdcall"+k_cplusplus = lvarid t_cplusplus "cplusplus"+k_dotnet = lvarid t_dotnet "dotnet"+k_jvm = lvarid t_jvm "jvm"+k_haskellcall = lvarid t_haskell "haskell"+k_safe = lvarid t_safe "safe"+k_unsafe = lvarid t_unsafe "unsafe"+k_noproto = lvarid t_noproto "noproto"+k_cast = lvarid t_cast "cast"++lvarop :: TokenId -> String -> Parser Pos [PosToken] c+lvarop tid str = token (\pos t -> case t of L_AVAROP v | v == tid -> Right pos;  x -> Left str)++lvarid :: TokenId -> String -> Parser Pos [PosToken] c+lvarid tid str = token (\pos t -> case t of L_AVARID v | v == tid -> Right pos;  x -> Left str)++lconid :: TokenId -> String -> Parser Pos [PosToken] c+lconid tid str = token (\pos t -> case t of L_ACONID v | v == tid -> Right pos;  x -> Left str)++lcurl :: Parser Pos [PosToken] c+lcurl  = lit L_LCURL' `orelse` lit L_LCURL+larrow :: Parser Pos [PosToken] c+larrow = lit L_LessMinus+rarrow :: Parser Pos [PosToken] c+rarrow = lit L_MinusGreater+impl :: Parser Pos [PosToken] c+impl   = lit L_EqualGreater+comma :: Parser Pos [PosToken] c+comma  = lit L_COMMA+semi :: Parser Pos [PosToken] c+semi   = lit L_SEMI' `orelse` lit L_SEMI+equal :: Parser Pos [PosToken] c+equal  = lit L_Equal+pipe :: Parser Pos [PosToken] c+pipe   = lit L_Pipe+dotdot :: Parser Pos [PosToken] c+dotdot = lit L_DotDot+coloncolon :: Parser Pos [PosToken] c+coloncolon = lit L_ColonColon+backtick :: Parser Pos [PosToken] c+backtick = lit L_BACKTICK++rational :: Parser (Pos,Lit Boxed) [PosToken] c+rational  = token (\pos t -> case t of L_RATIONAL x -> Right (pos, LitRational Boxed x) ; _ -> Left "<rational>")+integer :: Parser (Pos,Lit Boxed) [PosToken] c+integer = token (\pos t -> case t of L_INTEGER x -> Right (pos, LitInteger Boxed x) ; _ -> Left "<integer>")+int :: Parser (Pos,Lit Boxed) [PosToken] c+int = token (\pos t -> case t of L_INTEGER x -> Right (pos, LitInt Boxed (fromInteger x)) ; _ -> Left "<int>")+intPrim = token (\pos t -> case t of L_INTEGER x -> Right ((fromInteger x) :: Int) ; _ -> Left "<intPrim>")++-- double :: Parser (Pos,Lit Boxed) [PosToken] c+-- double  = token (\pos t -> case t of L_DOUBLE x -> Right (pos, LitDouble Boxed x) ; _ -> Left "<double>")+char :: Parser (Pos,Lit Boxed) [PosToken] c+char   = token (\pos t -> case t of L_CHAR x   -> Right (pos, LitChar Boxed x) ; _ -> Left "<char>")+string :: Parser (Pos,Lit Boxed) [PosToken] c+string = token (\pos t -> case t of L_STRING x -> Right (pos, LitString Boxed x) ; _ -> Left "<string>")++tuple0 = token (\pos t -> case t of L_ACONID x | isUnit x -> Right (pos,x) ; _ -> Left "()")++aconid = token (\pos t -> case t of L_ACONID x -> Right (pos,x) ; _ -> Left "<conid>")+aconop = token (\pos t -> case t of L_ACONOP x -> Right (pos,x) ; _ -> Left "<conop>")+avarid = token (\pos t -> case t of L_AVARID x -> Right (pos,x)+--			            L_primitive -> Right (pos,tprimitive)  -- Not a Haskell 1.3 reserved word+--			            L_prefix   -> Right (pos,tprefix)  -- Not a Haskell 1.3 reserved word+--			            L_unboxed  -> Right (pos,tunboxed) -- Not a Haskell 1.3 reserved word+--			            L_as       -> Right (pos,tas)      -- Not a Haskell 1.3 reserved word+				    _ -> Left "<varid>")+avarop = token (\pos t -> case t of L_AVAROP x -> Right (pos,x) ; _ -> Left "<varop>")++varid = avarid+           `orelse`+        lpar `revChk` avarop `chk` rpar+conid = aconid+           `orelse`+        lpar `revChk` aconop `chk` rpar++varop = avarop+           `orelse`+        backtick `revChk` avarid `chk` backtick+++conop = aconop+           `orelse`+        backtick `revChk` aconid `chk` backtick++anyop = (uncurry ExpConOp) `parseAp` conop+           `orelse`+        (uncurry ExpVarOp) `parseAp`  varop++anyid = (uncurry ExpCon) `parseAp`  conid+           `orelse`+        (uncurry ExpVar) `parseAp`  varid++aanyid = (uncurry ExpCon) `parseAp` aconid+           `orelse`+         (uncurry ExpVar) `parseAp` avarid++aanyop = (uncurry ExpConOp) `parseAp` aconop+           `orelse`+         (uncurry ExpVarOp) `parseAp` avarop
+ compiler98/ParseLib.hs view
@@ -0,0 +1,165 @@+module ParseLib(-- defined in ParseCore+                Pos, ParseError, ParseResult+               ,ParseBad, ParseGood, Parser+               ,initError,initBad,initGood      -- Start values for parseError,+						-- parseBad, parseGood+	       ,parseit+               ,parse, ap, chk, orelse, into    -- The core+               ,token                           -- parse terminal+               ,parseFail                       -- Failing parser+                -- defined in ParseLib+               ,revAp                           -- Apply snd to fst+               ,revChk                          -- Check fst+               ,cases                           -- Muliple chk+               ,parseAp, parseChk               -- parse & (ap | chk)+               ,apCut, chkCut, intoCut          -- No return if fst succeed+               ,literal                         -- Parse literal+	       ,optional, Maybe 		-- Zero or one item+               ,many, some                      -- Zero/one or more items.+						-- Cut after each item.+               ,manySep, someSep                -- Zero/one or more items with+						-- separator.  Cut after each+						-- item.+               ,manysSep, somesSep              -- Zero/one or more items with+						-- one or more separators. Cut+						-- after each item.+               ,rcurl                           -- Parse '}' and fix one if+						-- needed and possible.+               ,parseRest                       -- Always true, returns rest+						-- of the input+               ) where++import Lex+import Lexical(PosToken,lexicalCont)+import ParseCore++infixl 5 `parseAp`+infixl 5 `revAp`+infixl 5 `apCut`+infixl 5 `parseChk`+infixl 5 `revChk`+infixl 5 `chkCut`++-- #if defined(__HASKELL98__)+-- #define EVAL(b)+-- #else+-- #define EVAL(b) (Eval b) =>+-- #endif+++revAp :: Parser a i c -> Parser (a->b) i c -> Parser b i c+revAp     x y = \good bad ->+                x       (\u -> y (\v -> let vu = v u in seq vu (good vu)) bad)+                        bad++revChk :: Parser a i c -> Parser b i c -> Parser b i c+revChk     x y = \good bad ->+                x       (\_  -> y good bad)+                        bad+++cases :: [(Lex,Pos -> Parser  b  [PosToken] c)]+       -> Parser b  [PosToken] c+       -> Parser b  [PosToken] c+cases tps dp = \good bad input@((pos,t,_,_):input') err@(pe,et,msg) ->+        if pe > pos then+                cases' pos t good input' (dp good bad input err) tps+        else+                cases'' pos t good input' (dp good bad input) pos (show t) (if pos > pe then [] else msg)  tps+        where++        cases' :: Pos -> Lex -> ParseGood b [PosToken] c+                                  -> [PosToken]+                                  -> ParseResult c [PosToken]+                                  -> [(Lex,Pos -> Parser b  [PosToken] c)]+                                  -> ParseResult c [PosToken]+        cases' pos t good input' dp [] =+                dp+        cases' pos t good input' dp ((t',p):tps) =+                if t == t' then+                        p pos good initBad input' initError+                else+                        cases' pos t good input' dp tps++        cases'' :: Pos -> Lex -> ParseGood b [PosToken] c+                                   -> [PosToken]+                                   -> (ParseError -> ParseResult c [PosToken])+                                   -> Pos+                                   -> String+                                   -> [String]+                                   -> [(Lex,Pos -> Parser b  [PosToken] c)]+                                   -> ParseResult c [PosToken]+        cases'' pos t good input' dp ep et em [] =+                dp (ep,et,em)+        cases'' pos t good input' dp ep et em ((t',p):tps) =+                if t == t' then+                        p pos good initBad input' initError+                else+                        cases'' pos t good input' dp ep et (show t' : em) tps+++parseAp :: (a->b) -> Parser a i c -> Parser b i c+parseAp     x y = \good ->+                        y (\v -> let xv = x v in seq xv (good xv) )++parseChk :: b -> Parser a i c -> Parser b i c+parseChk    x y = \good ->+                        y (\_  -> good x)++apCut :: Parser (a->b) i c -> Parser a i c -> Parser b i c+apCut     x y = \good bad->+                x       (\u input' err' -> y (\v -> let uv = u v in seq uv (good uv)) initBad input' initError)+                        bad++chkCut :: Parser b i c -> Parser a i c -> Parser b i c+chkCut     x y = \good bad ->+                x       (\u input' err' -> y (\_ -> good u) initBad input' initError )+                        bad++intoCut :: Parser a i c -> (a->Parser b i c) -> Parser b i c+intoCut   x y = \good bad ->+                x       (\u input' err' -> y u good initBad input' initError)+                        bad++---------  Next section doesn't care about the internal structure+literal t = token (\pos t' -> if t==t' then Right pos else Left (show t))++optional p = Just `parseAp` p+		`orelse`+	     parse Nothing++many p = some p `orelse` parse []++some p = (:) `parseAp` p `apCut` many p++manySep' s p = s `revChk` someSep s p+                 `orelse`+               parse []++manySep s p = someSep s p `orelse` parse []+someSep s p = (:) `parseAp` p `apCut` manySep' s p++manysSep' s p = many s `revChk` somesSep s p+                  `orelse`+                parse []+manysSep s p = somesSep s p `orelse` parse []+somesSep s p = (:) `parseAp` p `apCut` manysSep' s p++--- Really specialized ++rcurl :: Parser Lex  [PosToken] c    +rcurl = \good bad (pt@(pos,t,_,_):input) err ->+        case t of+          L_RCURL  -> good t input err+          L_RCURL' -> good t input err+          _        -> case lexicalCont pt of+                        Left m        -> bad (maxError (pos, show t ,["}'"]) err)+                        Right input'  -> good L_RCURL' input' err+++-- Accept the rest of the input+parseRest :: Parser [PosToken]  [PosToken] c    +parseRest = \good bad input err -> good input input err+++
+ compiler98/PrettyLib.hs view
@@ -0,0 +1,450 @@+{-+A simple pretty printer combinator library.++A pretty printer converts an inductively defined data structure (i.e. a tree)+into a text (i.e. a list of lines).+Indentation of lines reflects the tree form of the data structure.+However, to produce only a minimal number of lines substructures are put+on a single line as far as possible.++The combinators provided here enable simple definition of a pretty printer +for any tree structure.+The pretty printer requires time linear in the size of the data structure+and space linear in the desired maximal width of the output.+The interface of the library is based on:+  Philip Wadler: A prettier printer, +  http://cm.bell-labs.com/cm/cs/who/wadler/topics/recent.html+The implementation uses some ideas from+  Derek C Oppen: Prettyprinting, TOPLAS volume 2 number 4, ACM, 1980, 465-483.+(Wadler's implementation performs some backtracking and hence may require time+linear in both the size of the data structure and the maximal width.)+-}+module PrettyLib (nil,(<>),text,line,delimiter,fdelimiter,group,nest,groupNest+                 ,Doc+                 ,parens,brackets,braces,string+                 ,pretty,simple) where+++{- Exported definitions ================================================== -}+-- Core pretty printer combinators ------------------------------------------++infixr 6 <>++nil :: Doc+nil = NIL++(<>) :: Doc -> Doc -> Doc+(<>) = (:<>)++text :: String -> Doc+text = TEXT++delimiter :: String -> Doc+delimiter = DELIMITER++{- +Fill line, that is, +only make newline if part up to next possible newline does not fit on line.+-}+fdelimiter :: String -> Doc+fdelimiter = FDELIMITER++{-+Force line break. The surrounding groups cannot fit on one line.+-}+line :: Doc+line = LINE++group :: Doc -> Doc+group = GROUP++nest :: Int -> Doc -> Doc+nest = NEST++-- Derived pretty printer combinators ---------------------------------------++{-+The often used combination of group and nest.+-}+groupNest :: Int -> Doc -> Doc+groupNest indentation doc = group (nest indentation doc)++parens :: Doc -> Doc+parens doc = text "(" <> doc <> text ")"++brackets :: Doc -> Doc+brackets doc = text "[" <> doc <> text "]"++braces :: Doc -> Doc+braces doc = text "{" <> doc <> text "}"++string :: String -> Doc+string s = text ('\"' : s ++ "\"")++{- Optimally pretty print the document within the given line width. -}+pretty :: Int -> Doc -> String+pretty width = layout width . normalise . removeFDelimiter . flatten ++{- Never turn a delimiter into a newline. -}++simple :: Doc -> String+simple = token2String . flatten+++{- Implementation ========================================================= -}++data Doc = NIL | Doc :<> Doc +         | TEXT String | DELIMITER String | FDELIMITER String | LINE +         | GROUP Doc | NEST Int Doc+         deriving Show+++data Token = Text String Int +           | Delimiter String Int Int | FDelimiter String Int Int | Line Int +           | Open | Close+           deriving Show+++{- +Staightforward conversion of tokens into a string,+ignoring brackets and possiblity of turning delimiters into newlines.+-}+token2String :: [Token] -> String++token2String [] = ""+token2String (Text s _ : tokens) = s ++ token2String tokens+token2String (Delimiter s _ _ : tokens) = s ++ token2String tokens+token2String (FDelimiter s _ _ : tokens) = s ++ token2String tokens+token2String (Line i : tokens) = '\n' : replicate i ' ' ++ token2String tokens+token2String (Open : tokens) = token2String tokens+token2String (Close : tokens) = token2String tokens+ ++{-+Convert the tree structure of a document into a stream of tokens.+A group is repesented by an opening and a closing bracket.+-}+flatten :: Doc -> [Token]++flatten doc = go 0 doc []+  where+  go :: Int -> Doc -> [Token] -> [Token]+  {- use accumulator to perform flattening in linear time -}+  go i NIL rest = rest+  go i (d1 :<> d2) rest = go i d1 (go i d2 rest)+  go i (TEXT s) rest = Text s (length s) : rest+  go i (DELIMITER s) rest = Delimiter s (length s) i : rest+  go i (FDELIMITER s) rest = FDelimiter s (length s) i : rest+  go i LINE rest = Line i : rest+  go i (GROUP doc) rest = Open : go i doc (Close : rest)+  go i (NEST j doc) rest = go (i+j) doc rest+++{-+Replace FDelimiter s l i by Open, Delimiter s l i, ..., Close.+So that Close is in front of the next (F)Delimiter s l i of the+same group or the next Close or the end.+-}+removeFDelimiter :: [Token] -> [Token]++removeFDelimiter = go 0 [] +  where+  {-+  Invariants: elements of stack are strictly sorted, largest on top+              nesting depth is greater or equal top element of stack (if ex.)+  -}+  go :: Int {- nesting depth of brackets; without new ones -}+     -> [Int] {- stack for closing brackets that still have to be inserted -}+     -> [Token] {- stream of tokens with FDelimiter -}+     -> [Token] {- stream of tokens without FDelimiter -}+  go _ [] [] = [] -- first argument should be 0+  go _ _  [] = [Close] -- the stack can at most contain one entry+  go d toClose (Open : tokens) = Open : go (d+1) toClose tokens+  go d toClose (Close : tokens) = +    possiblyClose (Close :) (subtract 1) id d toClose tokens+  go d toClose (FDelimiter s l i : tokens) =+    possiblyClose (\x -> Open : Delimiter s l i : x) id (d:) d toClose tokens+  go d toClose (Delimiter s l i : tokens) =+    possiblyClose (Delimiter s l i :) id id d toClose tokens+  go d toClose (Line i : tokens) =+    possiblyClose (Line i :) id id d toClose tokens+  go d toClose (text : tokens) = text : go d toClose tokens++  possiblyClose :: ([Token] -> [Token])  -- what to put into output stream+                -> (Int -> Int)          -- how to change nesting depth+                -> ([Int] -> [Int])      -- how to change stack+                -> Int                   -- nesting depth+                -> [Int]                 -- stack+                -> [Token]+                -> [Token]+  possiblyClose modOut modDepth modStack d (close : toClose) tokens+    | close == d = Close : modOut (go (modDepth d) (modStack toClose) tokens) +  possiblyClose modOut modDepth modStack d toClose tokens =+    modOut (go (modDepth d) (modStack toClose) tokens)+  ++{-+Normalise a stream of tokens wrt the following rewriting rules+Open, Text s l  ==> Text s l, Open+Close, Text s l ==> Text s l, Close+Then any block of brackets is followed by a Line s l i or the end of the stream+-}+normalise :: [Token] -> [Token]++normalise tokens = go 0 0 tokens+  where+  go :: Int {- number of deferred closing brackets -} +     -> Int {- number of deferred opening brackets -} +     -> [Token] {- stream of tokens to normalise -}+     -> [Token] {- normalised stream of tokens -}+  go i _ [] = replicate i Close -- there should be no deferred opening brackets+  go i j (Open : tokens) = go i (j+1) tokens+  go i j (Close : tokens)+    | j == 0    = go (i+1) j tokens+    | otherwise = go i (j-1) tokens+  go i j (deli@(Delimiter _ _ _) : tokens) =+    replicate i Close ++ replicate j Open ++ deli : go 0 0 tokens+  go i j (line@(Line _) : tokens) =+    replicate i Close ++ replicate j Open ++ line : go 0 0 tokens+  go i j (text : tokens) = text : go i j tokens+ ++{-+The list of tokens is optimally pretty printed within the given width.+Precondition: between a `Close' and a `Text s l' is always a `Line s l i'.+For efficiency also better if no `Open' is directly followed by `Text s l'.+A normalised token list has this property.+-}+layout :: Int {- width of layout -}+       -> [Token] +       -> String++layout width tokens = snd $ go width 1 empty1 0 tokens+  where+  go :: Int -- space remaining in current line (in characters)+     -> Int -- current stream position (in characters)+     -> Q1 Int -- queue of maximal streamposition for end of group to fit+     -> Int -- how deep inside a fitting group (<= 0: not in fitting group)+     -> [Token]+     -> (Q2 Bool -- queue which states if groups fit+        ,String) -- optimally layouted output+  go _ _ groupsMaxEnd _ [] = (empty2, "")+  go r p groupsMaxEnd fitDepth (Open : tokens) = (groupFits', string)+    where+    (groupsMaxEnd', fits', groupFits') = cons (r+p) groupsMaxEnd groupsFits+    (groupsFits, string) = go r p groupsMaxEnd' fitDepth' tokens+    fitDepth' = if fitDepth > 0 then succ fitDepth else if fits' then 1 else 0+  go r p groupsMaxEnd fitDepth (Close : tokens) +    | isEmpty1 groupsMaxEnd = go r p groupsMaxEnd (pred fitDepth) tokens+    | otherwise = (groupFits', string)+    where+    (_, groupsMaxEnd', groupFits') = lview groupsMaxEnd True groupFits+    (groupFits, string) = go r p groupsMaxEnd' (pred fitDepth) tokens+  go r p groupsMaxEnd fitDepth (Delimiter s l i : tokens)  = +    (groupFits', output ++ string)+    where+    (output, newRemainingSpace) +      | fitDepth > 0 = (s, r-l)+      | otherwise    = ('\n' : replicate i ' ', width-i)+    (groupFits', string) = +      checkGroupsMaxEnd newRemainingSpace (p+l) groupsMaxEnd fitDepth tokens +  go r p groupsMaxEnd fitDepth (Line i : tokens) =+    -- a compulsary newline makes all surrounding blocks not to fit+    (map1To2 (\_ -> False) groupsMaxEnd, '\n' : replicate i ' ' ++ string)+    where+    (_, string) = go (width-i) p empty1 fitDepth tokens+  go r p groupsMaxEnd fitDepth (Text s l : tokens) = (groupFits', s ++ string)+    where+    (groupFits', string) = +      checkGroupsMaxEnd (r-l) (p+l) groupsMaxEnd fitDepth tokens +++  checkGroupsMaxEnd :: Int -> Int -> Q1 Int -> Int -> [Token] +                    -> (Q2 Bool, String)+  checkGroupsMaxEnd r p groupsMaxEnd fitDepth tokens +    | isEmpty1 groupsMaxEnd || p <= maxEnd = +      go r p groupsMaxEnd fitDepth tokens+    | otherwise = (groupsFits', string)+    where+    (groupsMaxEnd', maxEnd, groupsFits') = rview groupsMaxEnd groupsFits False+    (groupsFits, string) = checkGroupsMaxEnd r p groupsMaxEnd' fitDepth tokens+++{- Special double ended queues -------------------------------------------- ++Two related kinds of double ended queue types are defined.+A queue operation always operates on two queues, one of each kind.+Each operation performs an operation on one queue and exactly the inverse+operation on the other queue.+For example, an operation that splits one queue into its first element and+the remaining queue, also puts an element in front of the other queue to obtain+a longer queue.++The inverse operations are very lazy.+Let there be a sequence of queue operations such that the first queue +resulting from an operation is always the input first queue to the +*next* operation and the second queue resulting from an operation is always +the input second queue to the *preceding* operation.+Let the first operation `cons' an element to the front of the first queue +and the last operation remove exactly this element from the first queue +(either front or rear). Then the last operation adds another element to +the second queue and the first operation removes exactly this element.+The operations on the second queue are so lazy that for obtaining this +element the second queue which is input to the last operation is not+demanded, that is, does not need to be evaluated.++Note that the inverse operations only work correctly, if the two queues+are passed in such a sequence. The implementation does not only assume+that the two queues handled by an operation have the same number of elements,+but also that they have the same internal structure.++Using a monad to ascertain correct passing of queues is possible but +seems rather restrictive and hides the idea. However, maybe another+kind of sequencing interface would be good to ensure safe usage.++            element                            element+               v                                  ^+  queue1  -> +----+ -> +---------+ ->     -> +---------+ ->+             |cons|    |operation|    ...    |operation|+          <- +----+ <- +---------+ <-     <- +---------+ <- queue2+               v                                  ^+            element'                           element'++Except for the additional lazy inverse operations the implementation agrees +with the Banker's queue given in:+  Chris Okasaki: Purely Functional Data Structures, CUP, 1998, Section 8.4.2 +-}++{-+q12List (Q1 _ f _ r) = f ++ reverse r+Furthermore, the structure contains the lengths of the two lists+Q2 does not contain lengths+-}++data Q1 a = Q1 !Int [a] !Int [a] deriving Show+data Q2 a = Q2 [a] [a] deriving Show+++reverse1 :: Q1 a -> Q1 a+reverse1 (Q1 lenf f lenr r) = Q1 lenr r lenf f++reverse2 :: Q2 a -> Q2 a+reverse2 (Q2 f r) = Q2 r f+++empty1 = Q1 0 [] 0 []+empty2 = Q2 [] []+++isEmpty1 (Q1 lenf _ lenr _) = lenf + lenr == 0 +++map1To2 :: (a -> b) -> Q1 a -> Q2 b+map1To2 g (Q1 _ f _ r) = Q2 (map g f) (map g r)+++{-+Keep lenghts of the two lists in balance+-}++check :: Int -> [a] -> Int -> [a] -> Q2 b -> (Q1 a, [b], [b])++check lenf f lenr r q2 =+  if lenf > balanceConstant * lenr + 1 then+    let+      len = lenf + lenr+      lenf' = len `div` 2+      lenr' = len - lenf'+      (f', rf') = splitAt lenf' f+      (r2, rf2) = lsplitAt lenr r2'+    in (Q1 lenf' f' lenr' (r ++ reverse rf')+       ,lappend lenf' f2' (lreverse (lenr'-lenr) rf2)+       ,r2)+   else+    (Q1 lenf f lenr r, f2', r2')+  where+  Q2 f2' r2' = q2+  balanceConstant = 3 :: Int+++{-+Put an element in front of the first list.+Inversely, split second list into front element and tail queue.+-}+cons :: a -> Q1 a -> Q2 b -> (Q1 a, b, Q2 b)++cons x (Q1 lenf f lenr r) q2' = (q', head f2, Q2 (tail f2) r2)+  where+  (q', f2, r2) = check (lenf+1) (x:f) lenr r q2'+++{-+Split first list into initial queue and rear element.+Inversely, add an element to rear of second list.+-}+rview :: Q1 a -> Q2 b -> b -> (Q1 a, a, Q2 b)++rview (Q1 _ (x:_) _ []) q2' y = (empty1, x, Q2 [y] [])+rview (Q1 _ [] _ []) _ _ = error "empty queue"+rview (Q1 lenf f lenr (x:r)) q2' y = (q', x, Q2 f2 (y:r2))+  where+  (q', f2, r2) = check lenf f (lenr-1) r q2'+++{-+Split first list into first element and tail queue.+Inversely, add an element to the front of the second list.+-}+lview :: Q1 a -> b -> Q2 b -> (a, Q1 a, Q2 b)++lview q1 y q2 = (x, reverse1 q1', reverse2 q2')+  where+  (q1', x, q2') = rview (reverse1 q1) (reverse2 q2) y+++{-+Some very lazy variants of standard list functions.+They get the length of the result or a list argument as first argument and +thus are able to construct the list structure of the result without demanding+evaluation of any of its other arguments.+Demanding some list element of the result will naturally lead to +more demand of the arguments.+-}+++{-+The first argument gives the length of the argument/result list.+-}+lreverse :: Int -> [a] -> [a]++lreverse n xs = lreverseAcc n xs []+  where+  lreverseAcc 0 _ acc = acc+  lreverseAcc n xs acc = lreverseAcc (n-1) ys (y:acc)+    where+    y:ys = xs++{-+The first argument gives the length of the first list argument.+-}+lappend :: Int -> [a] -> [a] -> [a]++lappend 0 _ zs = zs+lappend n xs zs = y : lappend (n-1) ys zs+  where+  y:ys = xs+++{-+The first argument gives the position at which the input list shall be split.+The list must be at least that long.+-}+lsplitAt :: Int -> [a] -> ([a], [a])+ +lsplitAt 0 xs = ([],xs)+lsplitAt n ys = (x:xs',xs'') +  where +  x:xs = ys+  (xs',xs'') = lsplitAt (n-1) xs++{- End PrettyLib ========================================================== -}
+ compiler98/PrettySyntax.hs view
@@ -0,0 +1,796 @@+{-+Convert abstract syntax tree (or parts of it) into +a structured document for pretty printing.+-}++module PrettySyntax+  ( PPInfo(..)+--  , prettyPrintSimple+  , prettyPrintTokenId, prettyPrintId, simplePrintId+  , ppModule, ppTopDecls, ppClassCodes+  , ppType, ppContexts, ppSimple, ppDecl+  ) where ++import Extra(noPos)+import PrettyLib+import Syntax hiding (noDecls,TokenId)+import TokenId(TokenId(..),extractV,t_Arrow,t_List)+import Id(Id)+import IntState(IntState,strIS,lookupIS)+import Nice(niceInt,niceNT,mkAL)+import Info(Info(InfoData),tidI)+import NT(NewType(NewType))+import SysDeps (unpackPS,isAlphaNum)+import Data.Maybe(isJust,fromJust)+import Flags(Flags,sShowWidth,sShowQualified,sShowIndent)+++{-+prettyPrintSimple :: Int -> (PPInfo TokenId -> a -> Doc) -> a -> String+prettyPrintSimple width pp =+  pretty width . +  pp PPInfo{withPositions = False+           ,indent = 4+           ,id2str = show+           ,tyVar2str = show+           ,intState = error "prettyPrintTokenId: no intState"+           ,isFunctionArrow = (== t_Arrow)+           ,isList = (== t_List)+           ,maybeTuple = maybeTupleTokenId}+  where+  maybeTupleTokenId t = case t of+                          TupleId n -> Just n+                          _         -> Nothing+-}++prettyPrintTokenId :: Flags -> (PPInfo TokenId -> a -> Doc) -> a -> String+prettyPrintTokenId flags pp =+  pretty (sShowWidth flags) . +  pp PPInfo{withPositions = False+           ,indent = sShowIndent flags+           ,id2str = id2strTokenId+           ,tyVar2str = show+           ,intState = error "prettyPrintTokenId: no intState"+           ,isFunctionArrow = (== t_Arrow)+           ,isList = (== t_List)+           ,maybeTuple = maybeTupleTokenId}+  where+  id2strTokenId =  if sShowQualified flags+                     then show  +                     else reverse . unpackPS . extractV +  maybeTupleTokenId t = case t of+                          TupleId n -> Just n+                          _         -> Nothing+++prettyPrintId :: Flags -> IntState -> (PPInfo Id -> a -> Doc) -> a -> String+prettyPrintId flags state pp =+  pretty (sShowWidth flags) . +  pp PPInfo{withPositions = False +           ,indent = sShowIndent flags+           ,id2str = if sShowQualified flags +                       then strIS state else strISunqualified state+           ,tyVar2str = ('t' :) . show+           ,intState = state+           ,isFunctionArrow = isFunctionArrowId state+           ,isList = isListId state +           ,maybeTuple = maybeTupleId state}+++simplePrintId :: IntState -> (PPInfo Id -> a -> Doc) -> a -> String+simplePrintId state pp =+  simple . +  pp PPInfo{withPositions = False +           ,indent = 2 +           ,id2str = strISunqualified state+           ,tyVar2str = ('t' :) . show+           ,intState = state+           ,isFunctionArrow = isFunctionArrowId state+           ,isList = isListId state +           ,maybeTuple = maybeTupleId state}+++-- the following little functions should probably be defined in some other+-- modules:++strISunqualified :: IntState -> Id -> String+strISunqualified state id = +  case lookupIS state id of+    Just info -> reverse . unpackPS . extractV . tidI $ info+    Nothing -> 'v' : show id+++isFunctionArrowId :: IntState -> Id -> Bool+isFunctionArrowId state id = +  case lookupIS state id of+    Just info -> tidI info == t_Arrow+    Nothing -> False+++isListId :: IntState -> Id -> Bool+isListId state id = +  case lookupIS state id of+    Just info -> tidI info == t_List +    Nothing -> False+++maybeTupleId :: IntState -> Id -> Maybe Int+maybeTupleId state id = +  case lookupIS state id of+    Just info -> case tidI info of+                   TupleId n -> Just n+                   _         -> Nothing +    Nothing -> Nothing+++{- +Information that is passed recursively unchanged +to all pretty printing functions.+If boolean argument true, then positions are inserted as comments +for most language constructs.+The function converts an identifier into a String.+-}++data PPInfo a = PPInfo {withPositions :: Bool+                       ,indent :: Int -- indentation for nesting+                       ,id2str :: a -> String+                       ,tyVar2str :: a -> String+                       ,intState :: IntState -- still needed for niceNT+                       ,isFunctionArrow :: a -> Bool -- ->+                       ,isList :: a -> Bool  -- []+                       ,maybeTuple :: a -> Maybe Int}+++{- standard number of characters of indentation for every nesting -}++nestS :: PPInfo a -> Doc -> Doc+nestS = nest . indent++groupNestS :: PPInfo a -> Doc -> Doc+groupNestS = groupNest . indent+++{- general formatting functions ------------------------------------------ -}++space :: Doc+space = text " "++dSpace :: Doc+dSpace = delimiter " "++fSpace :: Doc+fSpace = fdelimiter " "++fComma :: Doc+fComma = fdelimiter "" <> text ","++dSemiSpace :: Doc+dSemiSpace = delimiter "; "++sep :: Doc -> [Doc] -> Doc+sep delimiter [] = nil+sep delimiter docs = foldr1 (\l r -> l <> delimiter <> r) docs++term :: Doc -> [Doc] -> Doc+term delimiter = foldr (\l r -> l <> delimiter <> r) nil++encase :: Doc -> [Doc] -> Doc+encase delimiter docs = delimiter <> term delimiter docs++{- surround by paranthesis and separate by fComma, but not for 0 element -}+parensFComma1 :: PPInfo a -> [Doc] -> Doc+parensFComma1 info [] = nil+parensFComma1 info docs = +  fSpace <> (groupNestS info $ parens $ sep fComma docs)+++{- surround by paranthesis and separate by fComma, but not for 0 or 1 element +-}+parensFComma2 :: PPInfo a -> [Doc] -> Doc+parensFComma2 info [] = nil+parensFComma2 info [doc] = doc+parensFComma2 info docs = groupNestS info $ parens $ sep fComma docs +++groupParens :: PPInfo a -> Doc -> Doc+groupParens info = groupNestS info . parens+++{- the conversion functions for every abstract syntax construct ---------- -}++ppModule :: PPInfo a -> Module a -> Doc+ppModule info (Module pos id exports impdecls fixdecls topdecls) = +    groupNestS info +      (text "module " <> ppId info id <> +      ppExports info exports <> text " where") <> line <> +  ppImpDecls info impdecls <>+  ppFixDecls info fixdecls <> +  ppTopDecls info topdecls+++ppExports :: PPInfo a -> Maybe [Export a] -> Doc+ppExports info Nothing = parens nil+ppExports info (Just []) = nil+ppExports info (Just exps) = parensFComma1 info (map (ppExport info) exps)+++ppExport :: PPInfo a -> Export a -> Doc+ppExport info (ExportEntity pos entity) = ppEntity info entity+ppExport info (ExportModid pos id) = text "module " <> ppId info id +++ppEntity :: PPInfo a -> Entity a -> Doc+ppEntity info (EntityVar pos id) = ppIdAsVar info id+ppEntity info (EntityConClsAll pos id) = ppId info id <> text "(..)"+ppEntity info (EntityConClsSome pos id ids) = +  nestS info $ +    ppId info id <> (parens . sep fComma . map (ppIdAsVar info . snd) $ ids)+++ppImpDecls :: PPInfo a -> [ImpDecl a] -> Doc+ppImpDecls info [] = nil+ppImpDecls info decls = +  line <> (sep line . map (ppImpDecl info) $ decls) <> line+++ppFixDecls :: PPInfo a -> [FixDecl a] -> Doc+ppFixDecls info [] = nil+ppFixDecls info decls = +  line <> (sep line . map (ppFixDecl info) $ decls) <> line+++ppInfixClass :: PPInfo a -> InfixClass a -> Doc+ppInfixClass info InfixDef = text "infixl{-def-} "+ppInfixClass info InfixL   = text "infixl "+ppInfixClass info InfixR   = text "infixr "+ppInfixClass info Infix    = text "infix  "+ppInfixClass info (InfixPre id) = +  text "prefix " <> ppIdAsOperator info id <> space+++ppFixDecl :: PPInfo a -> FixDecl a -> Doc+ppFixDecl info (infixclass, precedenceLevel, fixIds) =+  groupNestS info $+    ppInfixClass info infixclass <> text (show precedenceLevel) <> +    fSpace <> sep fComma (map (ppIdAsOperator info . stripFixId) fixIds)+++ppImpSpec :: PPInfo a -> ImpSpec a -> Doc+ppImpSpec info (NoHiding entities) =+  fSpace <> (parens . sep fComma . map (ppEntity info) $ entities)+ppImpSpec info (Hiding []) = nil+ppImpSpec info (Hiding entities) =+  fSpace <> text "hiding " <> +  (parens . sep fComma . map (ppEntity info) $ entities)+++ppImpDecl :: PPInfo a -> ImpDecl a -> Doc+ppImpDecl info (Import (pos,id) impspec) =+  groupNestS info $ +    text "import " <> ppId info id <> fSpace <> ppImpSpec info impspec+ppImpDecl info (ImportQ (pos1,id1) impspec) =+  groupNestS info $+    text "import qualified " <> ppId info id1 <> fSpace <> +      ppImpSpec info impspec+ppImpDecl info (ImportQas (pos1,id1) (pos2,id2) impspec) =+  groupNestS info $+    text "import qualified " <> ppId info id1 <> fSpace <> text "as" <>+      fSpace <> ppId info id2 <> fSpace <> ppImpSpec info impspec+ppImpDecl info (Importas (pos1,id1) (pos2,id2) impspec) =+  groupNestS info $+    text "import " <> ppId info id1 <> fSpace <> text "as" <>+      fSpace <> ppId info id2 <> fSpace <> ppImpSpec info impspec++++ppTopDecls :: PPInfo a -> Decls a -> Doc+ppTopDecls info (DeclsParse decls) = +  line <> sep (line <> line) (map (ppDecl info) decls) <> line+ppTopDecls info (DeclsScc decls) = +  line <> sep (line <> line) (map (ppDeclsDepend info) decls) <> line+++ppDecls :: PPInfo a -> Decls a -> Doc+ppDecls info (DeclsParse decls) = +  group $ sep dSemiSpace (map (ppDecl info) decls)+ppDecls info (DeclsScc decls) = +  group $ sep dSemiSpace (map (ppDeclsDepend info) decls)+++ppDeclsDepend :: PPInfo a -> DeclsDepend a -> Doc+ppDeclsDepend info (DeclsNoRec decl)  =+  text "-- not recursive" <> line <> +  ppDecl info decl+ppDeclsDepend info (DeclsRec decls) =+  text "-- recursive" <> line <> +  sep line (map (ppDecl info) decls)+++ppType :: PPInfo a -> Type a -> Doc+ppType info = ppTypePrec info False+++ppTypePrec :: PPInfo a -> Bool {- with parens? -} -> Type a -> Doc+ppTypePrec info withPar (TypeCons pos t []) = ppId info t+ppTypePrec info withPar (TypeCons pos t ts) = +  if isFunctionArrow info t +    then case ts of+      [] -> text "(->)"+      [t1] -> parenExp info pos withPar $ +                text "(->)" <> ppTypePrec info True t1+      [t1,t2] -> parenExp info pos withPar $+                   ppTypePrec info True t1 <> fSpace <> text "->" <> fSpace <> +                   ppTypePrec info False t2+    else if isList info t+    then case ts of+      [] -> text "([])"+      [t] -> group $ brackets $ ppTypePrec info False t+    else case maybeTuple info t of+      Just n -> if n == length ts +                  then groupParens info . sep fComma . +                    map (ppTypePrec info False) $ ts+                  else  parenExp info pos withPar $+                    (groupParens info . sep fComma . replicate n $ nil) <>+                    fSpace <> (sep fSpace . map (ppTypePrec info True) $ ts)+      Nothing -> parenExp info pos withPar $ +        sep fSpace (ppId info t : map (ppTypePrec info True) ts)+ppTypePrec info withPar (TypeApp t1 t2) = +  parenExp info noPos withPar $+    (ppTypePrec info False t1 <> fSpace <> ppTypePrec info True t2)+ppTypePrec info withPar (TypeVar pos id) = ppTyVar info id+ppTypePrec info withPar (TypeStrict pos typ) = +  text "!" <> ppTypePrec info True typ+++ppTypeWithContext :: PPInfo a -> [Context a] -> Type a -> Doc+ppTypeWithContext info ctxs ty =+  group (ppContexts info ctxs <> ppType info ty)+++ppSimple :: PPInfo a -> Simple a -> Doc+ppSimple info (Simple pos id ids) = +  sep fSpace (ppId info id : map (ppId info . snd) ids) +++ppTypeSimple :: PPInfo a -> Simple a -> Doc+ppTypeSimple info (Simple pos id ids) = +  sep fSpace (ppId info id : map (ppTyVar info . snd) ids) +++ppContexts :: PPInfo a -> [Context a] -> Doc+ppContexts info []  = nil+ppContexts info cxs = +  parensFComma2 info (map (ppContext info) cxs) <> text " =>" <> fSpace+++ppContext :: PPInfo a -> Context a -> Doc+ppContext info (Context pos c vars) =+  ppId info c <> space <> sep fSpace (map (\(_,v)-> ppTyVar info v) vars)+++ppDerivings :: PPInfo a -> [(Pos, a)] -> Doc+ppDerivings info [] = nil+ppDerivings info ds  = +  groupNestS info $+    fSpace <> text "deriving" <>+    fSpace <> parensFComma2 info (map (ppId info . snd) ds) +++ppConstr :: PPInfo a -> Constr a -> Doc+ppConstr info (Constr pos c cs) =+  groupNestS info $+    ppIdAsVar info c <> fSpace <> ppFieldsType info cs+ppConstr info (ConstrCtx forall ctxs pos c cs) =+  groupNestS info $+    ppForall <> ppContexts info ctxs <> +    ppIdAsVar info c <> fSpace <> ppFieldsType info cs+  where+  ppForall | null forall = nil+           | otherwise   = groupNestS info (text "forall" <> fSpace <> +                             sep fSpace (map (ppTyVar info . snd) forall) <> +                             text ".") <> +                           fSpace+++ppFieldsType :: PPInfo a -> [(Maybe [(Pos,a)],Type a)] -> Doc+ppFieldsType info args@((Just _,_):_) = +  groupNestS info+    (braces . sep fComma . map (ppFieldType info) $ args)+ppFieldsType info args =+  group (sep fSpace . map (ppFieldType info) $ args)+++ppFieldType :: PPInfo a -> (Maybe [(Pos, a)], Type a) -> Doc+ppFieldType info (Nothing,typ) = ppTypePrec info True typ+ppFieldType info (Just posidents,typ) = +  group $+    (sep fComma . map (ppIdAsVar info . snd) $ posidents) <> +    dSpace <> +    text ":: " <> ppType info typ+++ppDecl :: PPInfo a -> Decl a -> Doc+ppDecl info (DeclType s t) =+  groupNestS info $+    text "type " <> ppTypeSimple info s <> text " =" <> dSpace <> ppType info t+ppDecl info (DeclTypeRenamed pos tyconid) =+  groupNestS info $+    text "type" <> fSpace <> +    (group . sep fSpace . map text $ +      (niceInt Nothing state tyconid "" : map snd al)) <>+    text " =" <> dSpace <> text (niceNT Nothing state al nt)+  where+  Just (InfoData _ _ _ newType _) = lookupIS state tyconid+  NewType univQuantTyVars _ _ [nt] = newType+  al = mkAL univQuantTyVars+  state = intState info+ppDecl info (DeclDataPrim pos conid size) =+  groupNestS info $+    text "data primitive" <> fSpace <>  ppPos info pos <> +    fSpace <> ppId info conid <> text " =" <> dSpace <> text (show size)+ppDecl info (DeclData dk ctxs s cs ds) =+  groupNestS info $+    text sort <> fSpace <> +    groupNestS info (ppContexts info ctxs <> ppTypeSimple info s) <>+    ppConstrs info cs <> ppDerivings info ds+  where+  sort = case dk of+           Nothing -> "newtype"+           Just False -> "data"+           Just True -> "data unboxed"+ppDecl info (DeclConstrs pos did cs) =+  groupNestS info $+    text "-- data/dataprim [(field,selector)] =" <> dSpace <>+    (groupNestS info $+      ppIdAsVar info did <> +      (brackets . sep fComma $ +        map (\(ps,field,sel) -> +                parens (ppIdAsVar info field <> space <> ppIdAsVar info sel)) +                       cs))+ppDecl info (DeclClass pos ctxs cls args fundeps decls) =+  nestS info $+    text "class" <> fSpace <>+    groupNestS info (ppContexts info ctxs <> ppId info cls <> space <> +      sep fSpace (map (ppTyVar info) args) <> ppFunDeps info fundeps)+    <> ppWhere info decls+ppDecl info (DeclInstance pos ctxs tycls insts valdefs) =+  nestS info $+    text "instance" <> fSpace <>+    groupNestS info (ppContexts info ctxs <> ppId info tycls <> space <>+      sep fSpace (map (parens . ppTypePrec info True) insts))+    <> ppWhere info valdefs +ppDecl info (DeclDefault ts) =+  groupNestS info $+    text "default" <> dSpace <> (parens . sep fComma . map (ppType info) $ ts)+ppDecl info (DeclPrimitive pos ident arity t) =+  groupNestS info $+    ppIdAsVar info ident <> fSpace <> text "primitive" <> fSpace +    <> text (show arity) <> text " ::" <> fSpace <> ppType info t+ppDecl info (DeclForeignImp pos callConv str ident arity cast t _) =+  groupNestS info $+    text "foreign import" <> fSpace <> text (show callConv) <> +    fSpace <> string str <> fSpace <>+    text (show cast) <> fSpace <> ppIdAsVar info ident <> text " ::" <> +    dSpace <> ppType info t+ppDecl info (DeclForeignExp pos callConv str ident t) =+  groupNestS info $+    text "foreign export" <> fSpace <> text (show callConv) <> fSpace <> +    ppIdAsVar info ident <> text " ::" <> dSpace <> ppType info t+ppDecl info (DeclVarsType ids ctxs t) =+  groupNestS info $+    group (sep fComma (map (ppIdAsVar info . snd) ids)) <> text " ::" <>+    dSpace <> ppTypeWithContext info ctxs t+ppDecl info (DeclPat alt) = group $ ppAlt info "=" alt+ppDecl info (DeclFun pos fun funs) =+  group $+    ppPos info pos <>+    (sep line . map (ppFun info fun) $ funs) +ppDecl info (DeclIgnore s) =+  text ("{- Ignoring " ++ s ++ " -}")+ppDecl info (DeclError s) =+  text ("ERROR:  " ++ s)+ppDecl info (DeclAnnot decl annots) =+  groupNestS info $ ppDecl info decl <> line <> ppAnnots info annots+ppDecl info (DeclFixity f) =+  ppFixDecl info f+++ppAnnots :: PPInfo a -> [Annot a] -> Doc+ppAnnots info = sep line . map (ppAnnot info) +++ppAnnot :: PPInfo a -> Annot a -> Doc+ppAnnot info (AnnotArity (pos,ident) int) =+  text "{-# ARITY " <> ppIdAsVar info ident <> text " = " <> +  text (show int) <> text "#-}"+ppAnnot info (AnnotPrimitive (pos,ident) prim) = +  text "{-# PRIMITIVE " <> ppIdAsVar info ident <> text " = " <> +  text (unpackPS prim) <> text "#-}"+ppAnnot info (AnnotNeed posidents) =+  text "{-# NEED " <> sep fSpace (map ppNeed posidents) <> text "#-}"+  where +  ppNeed [x] = ppIdAsVar info x+  ppNeed xs  = +    group $ text "{" <> sep fSpace (map (ppIdAsVar info) xs) <> text "}"+ppAnnot info (AnnotUnknown) =+  text "{-# ??? #-}"++ppFunDeps :: PPInfo a -> [FunDep a] -> Doc+ppFunDeps info [] = text ""+ppFunDeps info xs = text " | " <> sep (text ", ") (map (ppFunDep info) xs)++ppFunDep :: PPInfo a -> FunDep a -> Doc+ppFunDep info (as :->: bs) = ppTyVars as <> text "->" <> ppTyVars bs+  where+  --ppTyVars = parensFComma2 info . map (ppId info)+    ppTyVars = sep fSpace . map (ppId info)+++ppWhere :: PPInfo a -> Decls a -> Doc+ppWhere info decls +  | noDecls decls = nil+  | otherwise = line <> text "where" <> line <> ppTopDecls info decls+++ppClassCodes :: PPInfo a -> [ClassCode b a] -> Doc+ppClassCodes info decls = sep line (map (ppClassCode info) decls)+++ppClassCode :: PPInfo a -> ClassCode b a -> Doc+ppClassCode info (CodeClass pos cls) =+  groupNestS info $ text "code class" <> dSpace <> ppId info cls+ppClassCode info (CodeInstance pos cls typ arg ecs methods) =+  groupNestS info $ +    text "code instance" <> fSpace <> ppId info cls <> fSpace <> +    ppId info typ <> text " ? = ?" <> line <>+    sep dSemiSpace (map (ppIdAsVar info) methods)+++ppConstrs :: PPInfo a -> [Constr a] -> Doc+ppConstrs info [] = dSpace <> text "{- no constructors -}"+ppConstrs info cs = +  text " =" <> fSpace <> +  group (sep (fSpace <> text "| ") (map (ppConstr info) cs))+++ppFun :: PPInfo a -> a -> Fun a -> Doc+ppFun info id (Fun pats rhs w) =+  groupNestS info $+    (group +      (group $ sep fSpace $ +        ppIdAsVar info id : map (ppExpPrec info True) pats) <>+      ppRhs info "=" rhs) <>+    ppWhere info w+++ppStmts :: PPInfo a -> [Stmt a] -> Doc+ppStmts info stmts = sep line (map (ppStmt info) stmts)+++ppStmt :: PPInfo a -> Stmt a -> Doc+ppStmt info (StmtExp exp) = ppExp info exp+ppStmt info (StmtBind pat exp) = +  groupNestS info $+    ppPat info pat <> dSpace <> text "<- " <> ppExp info exp+ppStmt info (StmtLet ds) = +  groupNestS info $ text "let" <> dSpace <> ppDecls info ds +++ppPat :: PPInfo a -> Exp a -> Doc+ppPat = ppExp+++ppPos :: PPInfo a -> Pos -> Doc +ppPos info pos = +  if withPositions info then (braces . text . show $ pos) <> space else nil+++parenExp :: PPInfo a -> Pos -> Bool -> Doc -> Doc+parenExp info pos withPar doc =+  groupNestS info $ +    ppPos info pos <> if withPar then parens doc else doc+++ppExp :: PPInfo a -> Exp a -> Doc+ppExp info = ppExpPrec info False+++ppExpPrec :: PPInfo a -> Bool -> Exp a -> Doc+ppExpPrec info withPar (ExpLambda pos pats e) =+  parenExp info pos withPar $+    text "\\ " <> sep fSpace (map (ppLambdaPat info) pats) <>+    text " ->" <> dSpace <> ppExpPrec info False e+ppExpPrec info withPar (ExpDo pos stmts) =+  parenExp info pos withPar $+    text "do" <> dSpace <> ppStmts info stmts+ppExpPrec info withPar (ExpLet pos ds e) =+  parenExp info pos withPar $+    text "let" <> dSpace <> ppDecls info ds <> fSpace <> text "in" <> fSpace <>+    parens (ppExpPrec info False e) +ppExpPrec info withPar (ExpCase pos e alts) =+  parenExp info pos withPar $+    group+      (text "case" <> dSpace <> ppExpPrec info False e <> text " of")+    <> dSpace <>+    sep dSemiSpace (map (ppAlt info "->") alts)+ppExpPrec info _ (ExpFail) =  text "fail"+ppExpPrec info withPar (ExpFatbar e1 e2) =+  parenExp info noPos withPar $+    text "fatbar" <> dSpace <> ppExpPrec info False e1 <> dSpace <> +    text "-- " <> ppExpPrec info False e2 +ppExpPrec info withPar (ExpIf pos c e1 e2) =+  parenExp info pos withPar $+    text "if " <> ppExpPrec info False c <> dSpace <>+    text "then " <> ppExpPrec info False e1 <> dSpace <>+    text "else " <> ppExpPrec info False e2+ppExpPrec info withPar (ExpType pos e cxs t) =+  parenExp info pos withPar $+    ppExpPrec info False e <> dSpace <> +    text ":: " <> ppTypeWithContext info cxs t+ppExpPrec info withPar (ExpRecord exp fields) =+  parenExp info noPos withPar $+    ppExpPrec info True exp <> dSpace <> +    (braces . sep fComma . map (ppField info) $ fields)+ppExpPrec info withPar (ExpApplication pos (ExpCon _ id : args)) +  | isJust tuple && n == length args =+    ppPos info pos <> +    (groupParens info . sep fComma . map (ppExpPrec info False) $ args)+  where+  tuple = maybeTuple info id+  Just n = tuple+ppExpPrec info withPar (ExpApplication pos (op : args)) +  | isJust maybeConOrVarId && idIsOperator info id =+    case args of+      -- assume application consists of at least two expressions+      [arg1] -> groupParens info $+                  ppExpPrec info True arg1 <> dSpace <> ppIdAsOperator info id+      [arg1,arg2] ->  groupParens info $ +                        ppExpPrec info True arg1 <> dSpace <> +                        ppIdAsOperator info id <> dSpace <>+                        ppExpPrec info True arg2 +      (arg1:arg2:args) -> ppExpPrec info withPar +                            (ExpApplication pos +                              ((ExpApplication noPos [op,arg1,arg2]) : args))+  where+  maybeConOrVarId = case op of+                      ExpCon _ id -> Just id+                      ExpVar _ id -> Just id+                      _           -> Nothing+  id = fromJust maybeConOrVarId+ppExpPrec info withPar (ExpApplication pos exps) =+  parenExp info pos withPar $+    sep fSpace $ map (ppExpPrec info True) exps+ppExpPrec info withPar (ExpInfixList pos exps) =+  parenExp info pos withPar $+    sep fSpace $ map (ppExpPrec info True) exps+ppExpPrec info _ (ExpConOp pos id) = +  ppPos info pos <> ppIdAsOperator info id+ppExpPrec info _ (ExpVarOp pos id) = +  ppPos info pos <> ppIdAsOperator info id+ppExpPrec info _ (ExpCon pos id) = +  ppPos info pos <> +    case maybeTuple info id of+      Just n -> groupParens info . sep fComma . replicate n $ nil+      Nothing ->  ppIdAsVar info id+ppExpPrec info _ (ExpVar pos id) = +  ppPos info pos <> ppIdAsVar info id+ppExpPrec info withPar (ExpDict exp) = +  parenExp info noPos withPar $+    text "{d} " <> ppExpPrec info False exp+ppExpPrec info _ (ExpLit pos lit) = +  ppPos info pos <> text (show lit)+ppExpPrec info _ (ExpList pos es) =+  groupNestS info $+    ppPos info pos <> (brackets $ sep fComma $ map (ppExpPrec info False) es)+ppExpPrec info _ (Exp2 pos id1 id2) = +  ppPos info pos <> ppId info id1 <> text "." <> ppIdAsVar info id2+ppExpPrec info withPar (PatAs pos id pat) =+  parenExp info pos withPar $+    ppIdAsVar info id <> text "@" <> ppExpPrec info True pat+ppExpPrec info _ (PatWildcard pos) = +  ppPos info pos <> text "_"+ppExpPrec info _ (PatIrrefutable pos pat) =+  groupNestS info $ +    ppPos info pos <> text "~" <> ppExpPrec info True pat+ppExpPrec info withPar (PatNplusK pos n n' k _ _) =+  parenExp info pos withPar $+    ppIdAsVar info n <> fSpace <> text "+" <> fSpace <> ppExpPrec info True k +++ppLambdaPat :: PPInfo a -> Exp a -> Doc+ppLambdaPat info pat@(ExpApplication _ _) = ppExpPrec info True pat+ppLambdaPat info pat                      = ppExpPrec info False pat+++ppField :: PPInfo a -> Field a -> Doc+ppField info (FieldExp pos var exp) =+  groupNestS info $+    ppPos info pos <> ppIdAsVar info var <> dSpace <> text "= " <>  +    ppExp info exp+ppField info (FieldPun pos var) =+  ppPos info pos <> ppIdAsVar info var+++ppAlt :: PPInfo a -> String -> Alt a -> Doc+ppAlt info delimiter (Alt pat rhs w) =+  groupNestS info $+    group (ppPat info pat <> ppRhs info delimiter rhs) <>+    ppWhere info w+++ppRhs :: PPInfo a -> String -> Rhs a -> Doc+ppRhs info delimiter (Unguarded exp) =+  space <> text delimiter <> dSpace <> ppExp info exp+ppRhs info delimiter (Guarded [gd]) =+  dSpace <> ppGdPat info delimiter gd+ppRhs info delimiter (Guarded gds) =+  encase line (map (ppGdPat info delimiter) gds)+   ++ppGdPat :: PPInfo a -> String -> (Exp a, Exp a) -> Doc+ppGdPat info deli (e1,e2) =+  groupNestS info $+    text "| " <> ppExp info e1 <> space <> text deli <> dSpace <>+    ppExp info e2+++{- various formatting functions for identifiers ---------------------------- -}++ppId :: PPInfo a -> a -> Doc+ppId info id = text (id2str info id)+++{-+If the identifier is an operator, then surround it by paranthesis.+-}+ppIdAsVar :: PPInfo a -> a -> Doc+ppIdAsVar info id+  | isOperator name = text ('(' : name ++ ")")+  | otherwise       = text name+  where+  name = id2str info id++{-+if the identifier is a variable or constructor, then surround it by+backquotes.+-}+ppIdAsOperator :: PPInfo a -> a -> Doc+ppIdAsOperator info id +  | isOperator name = text name+  | otherwise       = text ('`' : name ++ "`")+  where+  name = id2str info id+++{-+Not nice: the unique of a type variable does not refer to a symbol table +entry. So it has to be handled specially.+-}++ppTyVar :: PPInfo a -> a -> Doc+ppTyVar info = text . tyVar2str info+++{- little helper functions ------------------------------------------------- -}++{- Test if declaration list empty -}+noDecls :: Decls id -> Bool+noDecls (DeclsParse decls) = null decls+noDecls (DeclsScc decls) = null decls+++{- Test if id is an operator -}+idIsOperator :: PPInfo a -> a -> Bool+idIsOperator info id = isOperator (id2str info id)+++{- Test if name is an operator -}+isOperator :: String -> Bool  +isOperator = not . isVarChar . last+  where+  isVarChar c = isAlphaNum c || c == '_' || c == '\'' +                 || c == ']'  -- empty list []+                 || c == '}'  -- traceId+++{- End PrettySyntax -------------------------------------------------------- -}
+ compiler98/Reduce.hs view
@@ -0,0 +1,15 @@+module Reduce where++infixl 5 >>>   -- Using >>> instead of >> to avoid problems with 1.3 Prelude++type Reduce  s   s' = s -> s'++unitR :: Reduce s s+unitR = id++(>>>) :: Reduce s s' -> Reduce s' s'' -> Reduce s s''+f >>> g = g . f++mapR :: (a->Reduce s s) -> [a] -> Reduce s s+mapR f []     = unitR+mapR f (x:xs) = f x >>> mapR f xs
+ compiler98/Syntax.hs view
@@ -0,0 +1,378 @@+module Syntax(module Syntax, Pos, TokenId) where++import Extra(Pos,strChr,strStr)+import SysDeps(PackedString)+import TokenId(TokenId)+import Id(Id)+import Data.Ratio+import Data.Maybe(isNothing,fromJust)++{-+Note that some syntactic constructs contain the syntactic construct +"Type". However, the rename pass replaces this representation by the internal+type representation "NewType" and "NT". So the syntactic constructs that+use "Type" are removed by the renaming pass or the type representation is only+half translated (TokenId -> Id). Are the latter still used later?++It probably would have been better if the whole syntax had been parameterised+with respect to the type representation; but such an additional parameter +would also be tiresome.+-}++data Module id =+--     module modid [export] where { impdecls; fixdecls; topdecls }+       Module Pos id (Maybe [Export id]) [ImpDecl id] [FixDecl id] (Decls id)++data Export id =+       ExportEntity  Pos (Entity id)  -- pos superfluous, same in entity?+     | ExportModid   Pos id++data ImpDecl id =+--     import ?qualified? modid ?as modid? ?hiding? (import,..)?+       Import    (Pos,id) (ImpSpec id)+     | ImportQ   (Pos,id) (ImpSpec id)+     | ImportQas (Pos,id) (Pos,id) (ImpSpec id)+     | Importas  (Pos,id) (Pos,id) (ImpSpec id)++importedModule :: ImpDecl a -> a+importedModule (Import (_,id) _) = id +importedModule (ImportQ (_,id) _) = id+importedModule (ImportQas (_,id) _ _) = id +importedModule (Importas (_,id) _ _) = id+++data ImpSpec id =+       NoHiding [Entity id]+     | Hiding   [Entity id]++data Entity id =+       EntityVar        Pos id             -- varid+     | EntityConClsAll  Pos id             -- TyCon(..) | TyCls(..)+     | EntityConClsSome Pos id [(Pos,id)]+	  -- TyCon | TyCls | TyCon(conid,..,conid) | TyCls(varid,..,varid) ++data InfixClass a =+                  InfixDef+                | InfixL+                | InfixR +                | Infix+                | InfixPre a++instance Eq (InfixClass a) where+        InfixDef   == InfixDef   = True+        InfixL     == InfixL     = True+        InfixR     == InfixR     = True+        Infix      == Infix      = True+        (InfixPre _) == (InfixPre _)  = True+        _          == _          = False++instance (Show a) => Show (InfixClass a) where+  showsPrec d InfixDef =  showString "infixl{-def-} "+  showsPrec d InfixL   =  showString "infixl "+  showsPrec d InfixR   =  showString "infixr "+  showsPrec d Infix    =  showString "infix  "+  showsPrec d (InfixPre a) =  showString "prefix " . shows a . showChar ' '+++type FixDecl id = (InfixClass id,Int,[FixId id])++data FixId a =+   FixCon Pos a+ | FixVar Pos a++stripFixId (FixCon _ a) = a+stripFixId (FixVar _ a) = a+++data Decls id =+   DeclsParse [Decl id]+ | DeclsScc [DeclsDepend id]++-- used very often:+noDecls :: Decls id+noDecls = DeclsParse []+++data DeclsDepend id =+       DeclsNoRec (Decl id)+     | DeclsRec   [Decl id]++data Decl id =+       -- | for type synonym: type   simple  = type+       DeclType (Simple id) (Type id)+       -- | renamer replaces DeclType by this.+       --   the type is in the symbol table, referenced by Id+     | DeclTypeRenamed Pos Id   -- intentionally not "id"++       -- | {Nothing = newtype, Just False = data, Just True = data unboxed}+       --   context => simple = constrs +       --   deriving (tycls)+     | DeclData (Maybe Bool) [Context id] (Simple id) [Constr id] [(Pos,id)]+       -- | data primitive conid size+     | DeclDataPrim Pos id Int+       -- | Introduced by Rename to mark that we might need +       --   to generate selector functions+       --       position data/dataprim [(field,selector)]+     | DeclConstrs Pos id [(Pos,id,id)] +       -- | class context => class where { signatures/valdefs; }+       --   position, context, class, type variables, fundeps, method decls+     | DeclClass Pos [Context id] id [id] [FunDep id] (Decls id)+       -- | instance context => tycls inst where { valdefs }+     | DeclInstance Pos [Context id] id [Instance id] (Decls id)+       -- | default (type,..)+     | DeclDefault [Type id]+       -- | var primitive arity :: type+     | DeclPrimitive Pos id Int (Type id)+       -- | foreign import [callconv] [extfun] [unsafe|cast|noproto] var :: type+       --                                   (final id part is wrapper-fn for IO)+       --               callconv extfun intfun arity [u|c|n] ty wrapperId+     | DeclForeignImp Pos CallConv String id Int Safety (Type id) id+       -- | foreign export  callconv  [extfun]  var :: type+     | DeclForeignExp Pos CallConv String id (Type id)+       -- | vars :: context => type+     | DeclVarsType [(Pos,id)] [Context id] (Type id)+     | DeclPat (Alt id)+     | DeclFun Pos id [Fun id] -- "var = ..." is a DeclFun, not a DeclPat+--   | DeclSelect id Int id  +       -- ^ introduced with pattern elimination (id = select Int id)+--     Used for unimplemented things+     | DeclIgnore String+     | DeclError String+     | DeclAnnot (Decl id) [Annot id]+--   | DeclPragma String String+     -- | infix[rl] int id,..,id+     | DeclFixity (FixDecl id)++-- for foreign imports/exports+data Safety = Unsafe | Safe+instance Show Safety where+  showsPrec _ Unsafe     = showString "unsafe"+  showsPrec _ Safe       = id++-- supported foreign calling conventions+data CallConv = C | Cast | Noproto | Haskell | Other String deriving Eq+instance Show CallConv where+  showsPrec _ C         = showString "ccall"+  showsPrec _ Cast      = showString "cast"+  showsPrec _ Noproto   = showString "noproto"+  showsPrec _ Haskell   = showString "haskell"+  showsPrec _ (Other s) = showString s+++data ClassCode ctx id = -- introduced by RmClasses+   CodeClass Pos id  -- class id+ | CodeInstance Pos id id [id] [ctx] [id]  +   -- class id, typ id, args, ctxs, method ids++-- | We parse MPTC with functional dependencies, only for hat-trans.+data FunDep id = [id] :->: [id]+++data Annot id = AnnotArity (Pos,id) Int+              | AnnotPrimitive (Pos,id) PackedString+              | AnnotNeed [[id]]+              | AnnotUnknown++--                 lhs pats, guarded exprs,   local defs+data Fun id = Fun  [Pat id] (Rhs id) (Decls id)++funArity :: Fun id -> Int+funArity = length . \(Fun ps _ _) -> ps++data Alt id = Alt  (Pat id) (Rhs id) (Decls id)++data Rhs id = Unguarded (Exp id)+            | Guarded [(Exp id,Exp id)]  -- the list has at least one element++data Type id =+       TypeCons         Pos id [Type id]+     | TypeApp          (Type id) (Type id)+     | TypeVar          Pos id+     | TypeStrict       Pos (Type id)++data Sig id = Sig [(Pos,id)] (Type id)  -- for interface file?++data Simple id = Simple Pos id [(Pos,id)]++simpleToType :: Simple id -> Type id+simpleToType (Simple pos tcId pargs) = +  TypeCons pos tcId (map (TypeVar pos . snd) pargs)++data Context id = Context Pos id [(Pos,id)]+++{-+Data constructor applied to type variables, possibly with field names.+As appearing on right hand side of data or newtype definition.+-}+-- ConstrCtx is always used if forall is specified+-- the intention is to remove Constr completely when all of nhc13 +-- have been updated +data Constr id = Constr +                   Pos       -- position of data constructor+                   id        -- data constructor+                   [(Maybe [(Pos,id)],Type id)]+                   -- argumentlist with field labels if any+                   -- (many field labels with same type possible)+                   -- the type admits impossible arguments:+                   -- either all arguments have field names or none+               | ConstrCtx  +                   [(Pos,id)]     -- type variabes from forall+                   [Context id]   -- context of data constructor+                   Pos +                   id        +                   [(Maybe [(Pos,id)],Type id)]++getConstrId :: Constr id -> id+getConstrId (Constr _ id _) = id+getConstrId (ConstrCtx _ _ _ id _) = id++getConstrArgumentList :: Constr id -> [(Maybe [(Pos,id)],Type id)]+getConstrArgumentList (Constr _ _ xs) = xs+getConstrArgumentList (ConstrCtx _ _ _ _ xs) = xs++getConstrLabels :: Constr id -> [(Pos,id)]+getConstrLabels constr =+  if null args || (isNothing . fst . head) args +    then []+    else concatMap (fromJust . fst) args+  where+  args = getConstrArgumentList constr++getConstrArgumentTypes :: Constr id -> [Type id]+getConstrArgumentTypes constr = +  concat . map (\(l,t) -> replicate (times l) t) . getConstrArgumentList $ +    constr+  where+  times Nothing = 1+  times (Just labels) = length labels ++constrArity :: Constr id -> Int+constrArity = length . getConstrArgumentTypes+++type Instance id = Type id  -- Not TypeVar+++{-+The following is ismorphic to the type constructor Qual.+Possibly Stmt should be removed and its usage replaced everywhere by Qual.+-}+data Stmt id =+    StmtExp  (Exp id)		-- exp+  | StmtBind (Exp id) (Exp id)	-- pat <- exp+  | StmtLet (Decls id)		-- let { decls ; }+++type Pat id = Exp id++data Exp id =  -- used both for expressions and patterns+      ExpScc            String (Exp id) +      -- ^ never used! should probably be removed+    | ExpDict           (Exp id)         -- hack to mark dictionary arguments+    | ExpLambda         Pos [(Pat id)] (Exp id)  -- \ pat ... pat -> exp+    | ExpLet            Pos (Decls id) (Exp id)  -- let { decls ; } in exp+    | ExpDo             Pos [Stmt id]            -- do { stmts ; }+    | ExpCase           Pos (Exp id) [Alt id]    -- case exp of { alts; }+    | ExpFatbar         (Exp id) (Exp id)+      -- ^ never used! should probably be removed+    | ExpFail+      -- ^ never used! should probably be removed+    | ExpIf             Pos (Exp id) (Exp id) (Exp id) 	+                        -- if exp then exp else exp+    | ExpType           Pos (Exp id) [Context id] (Type id)+                        -- exp :: context => type+--- Above only in expressions, not in patterns+    | ExpRecord	        (Exp id) [Field id]+    | ExpApplication    Pos [Exp id] -- always at least two elements?+    | ExpVar            Pos id+    | ExpCon            Pos id+    | ExpInfixList      Pos [Exp id] -- Temporary, introduced by parser because+    | ExpVarOp          Pos id       -- it does not know precedence and +    | ExpConOp          Pos id       -- associativity; removed by rename+    | ExpLit            Pos (Lit Boxed)+    | ExpList           Pos [Exp id]+--- after typechecker+    | Exp2              Pos id id  -- e.g.   Ord.Eq      or Eq.Int+--- Below only in patterns+    | PatAs             Pos id (Pat id)+    | PatWildcard       Pos+    | PatIrrefutable    Pos (Pat id)+-- idea: f (n+k) = exp[n]+--  =>   f n' | k <= n' = exp[n]+--         where n = n'-k +-- (n+k) pattern - store:   n  n' k        (k<=n')  (n'-k)+    | PatNplusK		Pos id id (Exp id) (Exp id) (Exp id)++data Field id = FieldExp  Pos id (Exp id)+              | FieldPun  Pos id     -- H98 removes (retained for error msgs)++data Boxed = Boxed | UnBoxed++instance Eq Boxed where+  Boxed == Boxed = True+  UnBoxed == UnBoxed = True+  _     == _       = False++instance Show Boxed where+  showsPrec d Boxed   = id+  showsPrec d UnBoxed = showChar '#'+++data Lit boxed =+      LitInteger  boxed Integer+    | LitRational boxed Rational+    | LitString   boxed String+    | LitInt      boxed Int+    | LitDouble   boxed Double+    | LitFloat    boxed Float+    | LitChar     boxed Char++instance (Eq b) => Eq (Lit b) where+     a == a' = litEqual a a'   -- litEqual needed in Symbols to force correct type in gofer++litEqual (LitInteger  b i) (LitInteger  b' i') = i == i' && b == b'+litEqual (LitRational b i) (LitRational b' i') = i == i' && b == b'+litEqual (LitString   b s) (LitString   b' s') = s == s' && b == b'+litEqual (LitInt      b i) (LitInt      b' i') = i == i' && b == b'+litEqual (LitDouble   b f) (LitDouble   b' f') = f == f' && b == b'+litEqual (LitFloat    b f) (LitFloat    b' f') = f == f' && b == b'+litEqual (LitChar     b c) (LitChar     b' c') = c == c' && b == b'+litEqual _                  _            = False++instance (Show b) => Show (Lit b) where+  showsPrec d lit = litshowsPrec d lit  -- litshowsPrec needed in Symbols to force correct type in gofer+++litshowsPrec d (LitInteger  b i) = showParen (i<0) (showsPrec d i) . shows b+litshowsPrec d (LitRational b i) = +  -- this is a hack to show a rational in floating point representation+  -- precision might be lost+  -- therer is no library function to print a rational in full precision+  -- in floating point representation+  showParen (i<0) (showsPrec d ((fromRational i)::Double)) . shows b+litshowsPrec d (LitString b str)= showString (strStr str) . shows b+litshowsPrec d (LitInt    b i)  = showParen (i<0) (showsPrec d i) . shows b+litshowsPrec d (LitDouble b f)  = showParen (f<0) (showsPrec d f) . shows b+litshowsPrec d (LitFloat  b f)  = showParen (f<0) (showsPrec d f) . shows b+litshowsPrec d (LitChar   b chr)= showString (strChr chr). shows b++data Qual id =+--       pat <- exp+      QualPatExp (Pat id) (Exp id)+--       pat+    | QualExp (Exp id)+--	 let decls+    | QualLet (Decls id)+++--------------------++data Interface id = +--      interface modid where {iimpdecl; fixdecl; itopdecl }+       Interface Pos id [IImpDecl id] [FixDecl id] (IDecls id)++type IImpDecl id = ImpDecl id -- No Hiding in ImpSpec++type IDecls id = Decls id -- No Valdef+
+ compiler98/SyntaxPos.hs view
@@ -0,0 +1,121 @@+module SyntaxPos(Pos,HasPos(..)) where++import Extra(Pos,noPos,mergePos,mergePoss)+import Syntax++class HasPos a where+        getPos :: a -> Pos++instance HasPos (Decls a) where+     getPos (DeclsParse decls) = getPos decls+     getPos (DeclsScc decls) = getPos decls++instance HasPos (DeclsDepend a) where+     getPos (DeclsNoRec decl) = getPos decl+     getPos (DeclsRec   decls) = getPos decls++instance HasPos (Decl a) where+  getPos (DeclType simple ty) = mergePos (getPos simple) (getPos ty)+  getPos (DeclDataPrim pos _ _) = pos+  getPos (DeclData _ ctx simple constrs derives) = +    mergePoss [getPos ctx,getPos simple,getPos constrs,getPosList derives]+  getPos (DeclConstrs pos _ _) = pos+  getPos (DeclClass pos _ _ _ _ _) = pos+  getPos (DeclInstance pos _ _ _ _) = pos+  getPos (DeclDefault tys) = getPos tys+  getPos (DeclVarsType ((pos,_):_) _ ty) = mergePos pos (getPos ty)+  getPos (DeclFun pos fun funs)       = pos+  getPos (DeclPrimitive pos fun a t)  = pos+  getPos (DeclForeignImp pos _ s fun a c t _) = pos+  getPos (DeclForeignExp pos _ s fun t) = pos+  getPos (DeclPat alt)                = getPos alt+  getPos (DeclIgnore str)             = noPos+  getPos (DeclError str)              = noPos++instance HasPos (Entity a) where+    getPos (EntityVar        pos _)   = pos+    getPos (EntityConClsAll  pos _)   = pos+    getPos (EntityConClsSome pos _ _) = pos++instance HasPos (Alt a) where+    getPos (Alt pat rhs locals) = +      mergePoss [getPos pat,getPos rhs,getPos locals]++instance HasPos (Fun a) where+    getPos (Fun pats rhs locals) = +      mergePoss [getPos pats,getPos rhs,getPos locals]++instance HasPos (Rhs a) where+    getPos (Unguarded e) = getPos e+    getPos (Guarded gdes) = +      mergePos (getPos (fst (head gdes))) (getPos (snd (last gdes)))++instance HasPos (Stmt a) where+  getPos (StmtExp exp) = getPos exp+  getPos (StmtBind pat exp) = mergePos (getPos pat) (getPos exp)+  getPos (StmtLet decls) = getPos decls++instance HasPos (Exp a) where+  getPos (ExpDict        exp)       = getPos exp+  getPos (ExpScc         str exp)   = getPos exp+  getPos (ExpLambda      pos _ _)   = pos+  getPos (ExpLet         pos _ _)   = pos+  getPos (ExpDo 	 pos _)	    = pos+  getPos (ExpCase        pos _ _)   = pos+  getPos (ExpFail)	 	    = error "No position for ExpFail"+  getPos (ExpIf          pos _ _ _) = pos+  getPos (ExpType        pos _ _ _) = pos+  getPos (ExpRecord      exp fdefs) = mergePos (getPos exp) (getPos fdefs)+  getPos (ExpApplication pos _ )    = pos+  getPos (ExpInfixList   pos _)     = pos+  getPos (ExpVar         pos _)     = pos+  getPos (ExpCon         pos _)     = pos+  getPos (ExpVarOp       pos _)     = pos+  getPos (ExpConOp       pos _)     = pos+  getPos (ExpLit         pos _)     = pos+  getPos (ExpList        pos _)     = pos+  getPos (Exp2           pos i1 i2) = pos+  getPos (PatAs          pos _ _)   = pos+  getPos (PatWildcard    pos)       = pos+  getPos (PatIrrefutable pos _)     = pos+  getPos (PatNplusK      pos _ _ _ _ _) = pos+++instance HasPos a => HasPos [a] where+    -- assumes that first and last element have proper positions+    getPos [] = noPos+    getPos xs = mergePos (getPos (head xs)) (getPos (last xs))++instance (HasPos a,HasPos b) => HasPos (a,b) where  -- used on GdExp+    getPos (a,b) = mergePos (getPos a) (getPos b)++instance HasPos (Simple a) where+    getPos (Simple pos _ _) = pos++instance HasPos (Type a) where+    getPos (TypeApp  t1 t2) = mergePos (getPos t1) (getPos t2)+    -- pos is position of constructor, not whole type, which shall be returned+    getPos (TypeCons pos _ (t:ts)) = mergePos (min pos (getPos t)) (getPos ts)+    getPos (TypeCons pos _ ts) = mergePos pos (getPos ts)+    getPos (TypeVar   pos _)   = pos+    getPos (TypeStrict  pos _)   = pos++instance HasPos (Context a) where+    getPos (Context pos _ _) = pos++instance HasPos (FixId a) where+    getPos (FixCon pos a) = pos+    getPos (FixVar pos a) = pos++instance HasPos (Field a) where+    getPos (FieldExp pos _ _) = pos+    getPos (FieldPun pos _) = pos++instance HasPos (Constr a) where+    getPos (Constr pos _ _) = pos+    getPos (ConstrCtx _ _ pos _ _) = pos+++getPosList :: [(Pos,a)] -> Pos+getPosList [] = noPos+getPosList xs = mergePos (fst (head xs)) (fst (last xs))
+ compiler98/SyntaxUtil.hs view
@@ -0,0 +1,47 @@+module SyntaxUtil(dropPatAs, infixFun, isCon+	, isExpInt, isExpIrr, isExpVar, isVar, isNK+	, isTypeVar+	) where++import Syntax+import SyntaxPos++-- CaseHelp++isVar (ExpVar _ _) = True+isVar (PatWildcard _) = True+isVar _ = False++isCon (ExpCon _ _) = True+isCon (ExpApplication _ (p:_)) = isCon p+isCon _ = False++isExpInt (ExpLit _ (LitInt _ _)) = True+isExpInt _ = False++isNK (PatNplusK _ _ _ _ _ _) = True+isNK _ = False++isExpIrr (PatIrrefutable _ _) = True+isExpIrr _ = False++dropPatAs (PatAs _ _ pat) = dropPatAs pat+dropPatAs pat = pat++isExpVar (ExpVar _ _) = True+isExpVar _ = False+++-- Rename++infixFun es =+  case break isExpVarOp es of+    (e1,ExpVarOp pos fun:e2) ->+      Just (ExpInfixList (getPos e1) e1,pos,fun,ExpInfixList (getPos e2) e2)+    _ -> Nothing++isExpVarOp (ExpVarOp _ _) = True+isExpVarOp _ = False++isTypeVar (TypeVar _ _ ) = True+isTypeVar _ = False
+ compiler98/SysDeps.hs view
@@ -0,0 +1,40 @@+module SysDeps (+   PackedString, packString, unpackPS, trace, isAlphaNum+) where++import qualified Data.ByteString.Char8 as PackedString+import Debug.Trace(trace)+import Data.Char(isAlphaNum)++type PackedString = PackedString.ByteString++packString :: String -> PackedString+packString = PackedString.pack++unpackPS :: PackedString -> String+unpackPS = PackedString.unpack++{--+#if __GLASGOW_HASKELL__ >= 502+import Data.PackedString as PackedString+#else+import PackedString+#endif++#if defined(__NHC__) || defined(__HBC__)+import NonStdTrace (trace)+#elif __GLASGOW_HASKELL__ >= 502+import Debug.Trace (trace)+#else+import IOExts      (trace)+#endif++#if defined(__HASKELL98__)+import Char        (isAlphaNum)+#else+import Data.Char        (isAlphanum)++isAlphaNum :: Char -> Bool+isAlphaNum = isAlphanum+#endif+--}
+ compiler98/TokenId.hs view
@@ -0,0 +1,384 @@+{- ---------------------------------------------------------------------------+Defines data type TokenId for names of all kinds of identifiers.+Also defines tokenIds for identifiers that are hardcoded into the compiler.+-}+module TokenId(module TokenId) where++import Data.Char(isUpper)+import Extra(isNhcOp,Pos,strPos)+import SysDeps(PackedString, unpackPS, packString)+++visible rtoken = Visible (packString rtoken)+qualify rmodule rtoken = Qualified (packString rmodule) (packString rtoken)+++data TokenId =+     TupleId Int -- no distinction between the type and the value constructor?+   | Visible   PackedString	-- unqualified name+   | Qualified PackedString PackedString+     -- token for qualified name: module name, variable name+   | Qualified2 TokenId TokenId	+     -- token with: class token, type token for a dictionary?+   | Qualified3 TokenId TokenId TokenId+     -- token for method in instance: class token, type token, method token+   deriving (Eq,Ord)+++instance Show TokenId where+  showsPrec d (TupleId s) = if s == 0+			    then showString "()"+	                    else showString "Prelude." . shows s+  showsPrec d (Visible n) = showString (reverse (unpackPS n))+  showsPrec d (Qualified m n ) = +    showString (reverse (unpackPS m)) . showChar '.' . +    showString (reverse (unpackPS  n))+  showsPrec d (Qualified2 t1 t2) = shows t1 . showChar '.' . shows t2+  showsPrec d (Qualified3 t1 t2 t3) = +    shows t1 . showChar '.' . shows t2 . showChar '.' . shows t3++mkUnqualifiedTokenId :: String -> TokenId+mkUnqualifiedTokenId = visible . reverse++mkQualifiedTokenId :: String -> String -> TokenId+mkQualifiedTokenId mod name = qualify (reverse mod) (reverse name)++getUnqualified :: TokenId -> String+getUnqualified = reverse . unpackPS . extractV++isTidOp :: TokenId -> Bool+isTidOp (TupleId s) = False+isTidOp tid = +  (isNhcOp . head . dropWhile (=='_') . reverse . unpackPS . extractV) tid++isTidCon :: TokenId -> Bool+isTidCon tid = isTupleId tid+               || (let x@(s:_) = (reverse . unpackPS . extractV) tid in+                   isUpper s || s==':' || x=="[]")++isTupleId :: TokenId -> Bool+isTupleId (TupleId _)        = True+isTupleId (Qualified2 _ t)   = isTupleId t+isTupleId (Qualified3 _ _ t) = isTupleId t+isTupleId _                  = False++--notPrelude (Qualified tid n) = tid /= rpsDPrelude && tid /= rpsPrelude+notPrelude (Qualified tid n) = (tid /= rpsPrelude) -- && (tid /= rpsInternal)+notPrelude (Qualified2 t1 t2) = notPrelude t1 && notPrelude t2 +notPrelude (Qualified3 t1 t2 t3) = notPrelude t1 && notPrelude t2 +notPrelude (TupleId _) = False+++{- construct Qualified2 token from given two tokens -}+mkQual2 :: TokenId -> TokenId -> TokenId+mkQual2 cls cls_typ = Qualified2 cls cls_typ+++{- construct Qualified3 token from given three tokens -}+mkQual3 :: TokenId -> TokenId -> TokenId -> TokenId+mkQual3 cls typ met = Qualified3 cls typ (dropM met)+++{- -}+mkQualD :: PackedString -> TokenId -> TokenId+mkQualD rps v@(Visible n) = Qualified3 (Visible rps) t_underscore v+mkQualD rps   (Qualified m v) = Qualified3 (Visible m) t_underscore (Visible v)+++{- if token is not qualified make it qualified with given module name -}+ensureM :: PackedString -> TokenId -> TokenId+ensureM tid (Visible n) = Qualified tid n+ensureM tid q = q+++{- make token into qualified token with given module name -}+forceM :: PackedString -> TokenId -> TokenId+forceM m (Qualified _ n) = Qualified m n+forceM m (Visible n)     = Qualified m n+forceM m tid = tid+++{- drop all qualification (module names) from token -}+dropM :: TokenId -> TokenId+dropM (Qualified tid n) = Visible n+dropM (Qualified2 t1 t2) = t2+dropM (Qualified3 t1 t2 t3) = t3+dropM v = v++{- get module name from token, correct for Visible? -}+extractM :: TokenId -> PackedString+extractM (Qualified tid n) = tid+extractM (Qualified2 t1 t2) = extractM t1+extractM (Qualified3 t1 t2 t3) = extractM t1+extractM v = rpsPrelude+++{- get identifier name from token, without qualification -}+extractV :: TokenId -> PackedString+extractV (TupleId n) = packString ('(' : foldr (:) ")" (replicate n ','))+extractV (Visible v) = v+extractV (Qualified m v) =  v+extractV (Qualified2 t1 t2) = extractV t2+extractV (Qualified3 t1 t2 t3) = extractV t3+++{- extend token by adding position to the identifier name -}+tidPos :: TokenId -> Pos -> TokenId+tidPos (TupleId s) pos = if s == 0 +		         then visImport ("():" ++ (strPos pos))+	                 else visImport (shows s (':' : strPos pos))+tidPos (Visible n)           pos = +  Visible (packString (reverse (strPos pos) ++ ':' : unpackPS n))+tidPos (Qualified m n )      pos = +  Qualified m (packString (reverse (strPos pos) ++ ':' : unpackPS n))+tidPos (Qualified2 t1 t2)    pos =+  Qualified2 t1 (tidPos t2 pos)+tidPos (Qualified3 t1 t2 t3) pos = +  Qualified3 t1 t2 (tidPos t3 pos)+++{- append given string to module name of qualified token -}+add2M :: String -> TokenId -> TokenId+add2M str (Qualified m v) =  +  Qualified (packString (reverse str ++ unpackPS m)) v++visImport = Visible . packString . reverse+qualImpPrel = Qualified rpsPrelude . packString . reverse+qualImpNHC = Qualified rpsInternal . packString . reverse+qualImpBin = Qualified rpsBinary  . packString . reverse+qualImpRat = Qualified rpsRatio   . packString . reverse+qualImpIx  = Qualified rpsIx      . packString . reverse+qualImpFFI = Qualified rpsFFI     . packString . reverse+qualImpPS  = Qualified rpsPS      . packString . reverse+qualImpIOE = Qualified rpsIOE     . packString . reverse++rpsPrelude      = (packString . reverse ) "Prelude"+rpsInternal     = (packString . reverse ) "NHC.Internal"+rpsRatio        = (packString . reverse ) "Ratio"+rpsIx           = (packString . reverse ) "Ix"+rpsFFI          = (packString . reverse ) "NHC.FFI"+rpsPS           = (packString . reverse ) "NHC.PackedString"+rpsIOE          = (packString . reverse ) "NHC.IOExtras"+rpsBinary       = (packString . reverse ) "NHC.Binary"+rpsHatHack      = (packString . reverse ) "Hat.Hack"+++isUnit (TupleId 0) = True+isUnit _ = False+++{- make token for tuple of given size -}+t_Tuple :: Int -> TokenId+t_Tuple  size   = TupleId size+++tmain = Qualified (packString (reverse "Main")) (packString (reverse "main"))++tPrelude        = Visible rpsPrelude+tHatHack        = Visible rpsHatHack+tNHCInternal    = Visible rpsInternal+t_underscore    = visImport "_"+t_Bang		= visImport "!"+t_Assign	= visImport ":="+tprefix	 	= visImport "prefix"+tqualified 	= visImport "qualified"+thiding	 	= visImport "hiding"+tas	 	= visImport "as"+tinterface 	= visImport "interface"+tforall	 	= visImport "forall"+tdot	 	= visImport "."        +  -- an unqualified dot, used in types, e.g., "forall a . [a]"+tunboxed	= visImport "unboxed"+tprimitive	= visImport "primitive"+tMain           = visImport  "Main"+tUnknown u      = visImport  ("Unexported.Constr_"++show u)++t_gtgteq        = qualImpPrel  ">>="+t_gtgt	        = qualImpPrel  ">>"+tfail	        = qualImpPrel  "fail"+t_error  	= qualImpPrel  "error"+t_undef         = qualImpPrel  "undefined"+tfromInteger    = qualImpPrel  "fromInteger"+tNum            = qualImpPrel  "Num"+tIntegral       = qualImpPrel  "Integral"+tInt            = qualImpPrel  "Int"+tIntHash        = qualImpPrel  "Int#"+++t_flip          = qualImpPrel  "flip"+tminus          = qualImpPrel  "-"+t_minus         = visImport    "-"+tident          = qualImpPrel  "id"+tnegate         = qualImpPrel  "negate"+tTrue           = qualImpPrel  "True"+tFalse          = qualImpPrel  "False"+tunknown        = visImport    "Unknown.variable"+terror          = qualImpPrel  "error"+tIO             = qualImpNHC   "IO"+tBool           = qualImpPrel  "Bool"+tFloatHash      = qualImpPrel  "Float#"+tFloat          = qualImpPrel  "Float"+tChar           = qualImpPrel  "Char"+t_List          = qualImpPrel  "[]"+t_ListNQ        = visImport    "[]"+t_Arrow         = qualImpPrel  "->"+t_Pair          = qualImpPrel  "(,"+tString         = qualImpPrel  "String"+t_filter        = qualImpPrel  "_filter" +t_foldr         = qualImpPrel  "_foldr" -- be careful, non-standard signature +t_Colon         = qualImpPrel  ":"+t_ColonNQ       = visImport    ":"+t_x             = visImport    "_x"+t_y             = visImport    "_y"+t_equalstring	= qualImpPrel  "_equalstring"+t_guardstring	= qualImpPrel  "_guardstring"+t_fail		= qualImpPrel  "_fail"+t_fatbar	= qualImpPrel  "_fatbar"+t_select	= qualImpPrel  "_select"+t_patbindupdate = qualImpPrel  "_patbindupdate"+t_callpatbindupdate = qualImpPrel  "_callpatbindupdate"+tDialogue       = qualImpPrel  "Dialogue"+t_apply1        = qualImpNHC  "_apply1"+t_apply2        = qualImpNHC  "_apply2"+t_apply3        = qualImpNHC  "_apply3"+t_apply4        = qualImpNHC  "_apply4"+t_used          = qualImpPrel  "used!"+tInteger        = qualImpPrel  "Integer"+tDouble         = qualImpPrel  "Double"+tDoubleHash     = qualImpPrel  "Double#"+tfromRational   = qualImpPrel  "fromRational"+t_equalinteger	= qualImpPrel  "_equalinteger"+t_guardinteger	= qualImpPrel  "_guardinteger"+t_nopos 	= qualImpPrel  "<no pos>"+t_fromEnum      = qualImpPrel  "_fromEnum"+t_toEnum        = qualImpPrel  "_toEnum"+--tEval           = qualImpPrel  "Eval"		-- Removed in Haskell 98+tEq             = qualImpPrel  "Eq"+tOrd            = qualImpPrel  "Ord"+tEnum           = qualImpPrel  "Enum"+tIx             = qualImpIx    "Ix"+tShow           = qualImpPrel  "Show"+tRead           = qualImpPrel  "Read"+t_andand        = qualImpPrel  "&&"+t_pipepipe      = qualImpPrel  "||"+tcompare	= qualImpPrel  "compare"+tLT		= qualImpPrel  "LT"+tEQ		= qualImpPrel  "EQ"+tGT		= qualImpPrel  "GT"+t_equalequal    = qualImpPrel  "=="+t_lessequal     = qualImpPrel  "<="+t_lessthan      = qualImpPrel  "<"+t_greater       = qualImpPrel  ">"+t_greaterequal  = qualImpPrel  ">="++tseq 	        = qualImpPrel  "seq"++trange          = qualImpIx  "range"+tindex          = qualImpIx  "index"+tinRange        = qualImpIx  "inRange"+t_tupleRange    = qualImpIx  "_tupleRange"+t_tupleIndex    = qualImpIx  "_tupleIndex"+t_enumRange     = qualImpPrel  "_enumRange"+t_enumIndex     = qualImpPrel  "_enumIndex"+t_enumInRange   = qualImpPrel  "_enumInRange"++tfromEnum	= qualImpPrel  "fromEnum"+ttoEnum		= qualImpPrel  "toEnum"+tenumFrom       = qualImpPrel  "enumFrom"+tenumFromTo     = qualImpPrel  "enumFromTo"+tenumFromThen   = qualImpPrel  "enumFromThen"+tenumFromThenTo = qualImpPrel  "enumFromThenTo"+t_enumFromTo    = qualImpPrel  "_enumFromTo"+t_enumFromThenTo= qualImpPrel  "_enumFromThenTo"++tBounded	= qualImpPrel  "Bounded"+tminBound	= qualImpPrel  "minBound"+tmaxBound	= qualImpPrel  "maxBound"++t_append	= qualImpPrel  "++"+t_readCon0	= qualImpPrel  "_readCon0"+t_readConInfix	= qualImpPrel  "_readConInfix"+t_readCon	= qualImpPrel  "_readCon"+t_readConArg	= qualImpPrel  "_readConArg"+t_readField 	= qualImpPrel  "_readField"+t_readFinal 	= qualImpPrel  "_readFinal"++tshowsPrec      = qualImpPrel  "showsPrec"+tshowsType      = qualImpPrel  "showsType"+treadsPrec      = qualImpPrel  "readsPrec"+t_dot           = qualImpPrel  "."+tshowString     = qualImpPrel  "showString"+tshowChar       = qualImpPrel  "showChar"+tshowParen      = qualImpPrel  "showParen"+treadParen      = qualImpPrel  "readParen"+tFractional     = qualImpPrel  "Fractional"+tRational       = qualImpRat  "Rational"	-- Changed in Haskell 98+tRatio          = qualImpRat  "Ratio"		-- Changed in Haskell 98+tRatioCon       = qualImpRat  "%"		-- Changed in Haskell 98+tPRIMITIVE      = visImport "PRIMITIVE"+tNEED           = visImport "NEED"+t_primitive     = visImport "primitive"+t_Lambda        = qualImpPrel  "\\"+t_eqInteger     = qualImpNHC  "_eqInteger"+t_eqDouble      = qualImpNHC  "_eqDouble"+t_eqFloat       = qualImpNHC  "_eqFloat"+t_otherwise	= tTrue++t_id            = qualImpNHC  "_id"   +  -- identity function that is not modified by the tracing transformation+++{- Malcolm's additions from here on -}++{- class + instances of Binary -}+tBinary		= qualImpBin  "Binary"+t_put	        = qualImpBin  "put"+t_get           = qualImpBin  "get"+t_getF          = qualImpBin  "getF"+t_sizeOf        = qualImpBin  "sizeOf"+t_putBits       = qualImpBin  "putBits"+t_getBits       = qualImpBin  "getBits"+t_getBitsF      = qualImpBin  "getBitsF"+t_ltlt          = qualImpBin  "<<"+t_return        = qualImpPrel  "return"+t_plus          = qualImpPrel  "+"++{- (N+K) patterns -}+t_nplusk        = visImport   "+"+t_subtract      = qualImpPrel  "subtract"++{- FFI -}+t_foreign	= visImport   "foreign"+t_export	= visImport   "export"+t_ccall		= visImport   "ccall"+t_stdcall	= visImport   "stdcall"+t_haskell	= visImport   "haskell"+t_noproto	= visImport   "noproto"+t_cplusplus	= visImport   "cplusplus"+t_dotnet	= visImport   "dotnet"+t_jvm		= visImport   "jvm"+t_cast		= visImport   "cast"+t_safe		= visImport   "safe"+t_unsafe	= visImport   "unsafe"+tAddr		= qualImpFFI  "Addr"+tPtr		= qualImpFFI  "Ptr"+tFunPtr		= qualImpFFI  "FunPtr"+tForeignObj	= qualImpFFI  "ForeignObj"+tForeignPtr	= qualImpFFI  "ForeignPtr"+tStablePtr	= qualImpFFI  "StablePtr"+--tWord		= qualImpFFI  "Word"+tInt8		= qualImpFFI  "Int8"+tInt16		= qualImpFFI  "Int16"+tInt32		= qualImpFFI  "Int32"+tInt64		= qualImpFFI  "Int64"+tWord8		= qualImpFFI  "Word8"+tWord16		= qualImpFFI  "Word16"+tWord32		= qualImpFFI  "Word32"+tWord64		= qualImpFFI  "Word64"+tPackedString	= qualImpPS   "PackedString"+tunsafePerformIO= qualImpNHC  "unsafePerformIO"++{- more FFI -}+t_mkIOok n      = qualImpNHC  ("_mkIOok"++show (n::Int))++{- End TokenId -------------------------------------------------------------}
+ compiler98/Tree234.hs view
@@ -0,0 +1,95 @@+-- Red-Black trees.+--  (was previously implemented as 2-3-4 trees, hence the module name.)+module Tree234+( Tree,+  initTree,+  treeAdd,+  treeAddList,+  treeFromList,+  treeSearch,+  treeUpdate,+  treeMap,+  treeMapList+) where++data Tree a+  = R (Tree a) a (Tree a)+  | B (Tree a) a (Tree a)+  | E+  deriving Show++initTree :: Tree a+initTree = E++treeAdd :: (a -> a -> a) -> (a -> a -> Ordering) -> a -> Tree a -> Tree a+treeAdd comb cmp a t = mkB (ins t)+  where+    mkB (R l a r) = B l a r+    mkB t         = t++    ins E = R E a E+    ins (B l b r)+      = case (cmp a b) of+        LT -> lbal (ins l) b r+        EQ -> B l (a `comb` b) r+        GT -> rbal l b (ins r)+    ins (R l b r)+      = case (cmp a b) of+        LT -> R (ins l) b r+        EQ -> R l (a `comb` b)  r+        GT -> R l b (ins r)++    lbal :: Tree a -> a -> Tree a -> Tree a+    lbal (R (R a x b) y c) z d = R (B a x b) y (B c z d)+    lbal (R a x (R b y c)) z d = R (B a x b) y (B c z d)+    lbal a x b                 = B a x b++    rbal :: Tree a -> a -> Tree a -> Tree a+    rbal a x (R (R b y c) z d) = R (B a x b) y (B c z d)+    rbal a x (R b y (R c z d)) = R (B a x b) y (B c z d)+    rbal a x b                 = B a x b++treeAddList :: (a -> a -> a) -> (a -> a -> Ordering) -> [a] -> Tree a -> Tree a+treeAddList comb cmp xs t = foldr (treeAdd comb cmp) t xs++treeFromList :: (a -> a -> a) -> (a -> a -> Ordering) -> [a] -> Tree a+treeFromList comb cmp l = treeAddList comb cmp l E++treeSearch :: b -> (a -> b) -> (a -> Ordering) -> Tree a -> b+treeSearch fail cont p E = fail+treeSearch fail cont p (R l a r)+  = case (p a) of+    LT -> treeSearch fail cont p l+    EQ -> cont a+    GT -> treeSearch fail cont p r+treeSearch fail cont p (B l a r)+  = case (p a) of+    LT -> treeSearch fail cont p l+    EQ -> cont a+    GT -> treeSearch fail cont p r++treeUpdate :: (a -> a) -> (a -> Ordering) -> Tree a -> Tree a+treeUpdate update p E = E+treeUpdate update p (R l a r)+  = case (p a) of+    LT -> R (treeUpdate update p l) a r+    EQ -> R l (update a) r+    GT -> R l a (treeUpdate update p r)+treeUpdate update p (B l a r)+  = case (p a) of+    LT -> B (treeUpdate update p l) a r+    EQ -> B l (update a) r+    GT -> B l a (treeUpdate update p r)++treeMap :: (a -> b) -> Tree a -> Tree b+treeMap f E         = E+treeMap f (B l a r) = B (treeMap f l) (f a) (treeMap f r)+treeMap f (R l a r) = R (treeMap f l) (f a) (treeMap f r)++treeMapList :: (a -> [b] -> [b]) -> Tree a -> [b]+treeMapList f t = treeFold f [] t++treeFold :: (a -> b -> b) -> b -> Tree a -> b+treeFold f c E         = c+treeFold f c (B l a r) = treeFold f (a `f` treeFold f c r) l+treeFold f c (R l a r) = treeFold f (a `f` treeFold f c r) l
+ compiler98/Unlit.hs view
@@ -0,0 +1,68 @@+module Unlit(unlit) where++-- Part of the following code is from+-- "Report on the Programming Language Haskell",+--   version 1.2, appendix C.++import Data.Char++data Classified = Program String | Blank | Comment+                | Include Int String | Pre String++classify :: [String] -> [Classified]+classify []                = []+classify (('\\':x):xs) | x == "begin{code}" = Blank : allProg xs+   where allProg [] = []  -- Should give an error message,+                          -- but I have no good position information.+         allProg (('\\':x):xs) |  x == "end{code}" = Blank : classify xs+	 allProg (x:xs) = Program x:allProg xs+classify (('>':x):xs)      = Program (' ':x) : classify xs+classify (('#':x):xs)      = (case words x of+                                (line:file:_) | all isDigit line+                                   -> Include (read line) file+                                _  -> Pre x+                             ) : classify xs+classify (x:xs) | all isSpace x = Blank:classify xs+classify (x:xs)                 = Comment:classify xs++unclassify :: Classified -> String+unclassify (Program s) = s+unclassify (Pre s)     = '#':s+unclassify (Include i f) = '#':' ':show i ++ ' ':f+unclassify Blank       = ""+unclassify Comment     = ""++unlit :: String -> String -> String+unlit file lhs = (unlines+                 . map unclassify+                 . adjecent file (0::Int) Blank+                 . classify) (inlines lhs)++adjecent :: String -> Int -> Classified -> [Classified] -> [Classified]+adjecent file 0 _             (x              :xs) = x : adjecent file 1 x xs -- force evaluation of line number+adjecent file n y@(Program _) (x@Comment      :xs) = error (message file n "program" "comment")+adjecent file n y@(Program _) (x@(Include i f):xs) = x: adjecent f    i     y xs+adjecent file n y@(Program _) (x@(Pre _)      :xs) = x: adjecent file (n+1) y xs+adjecent file n y@Comment     (x@(Program _)  :xs) = error (message file n "comment" "program")+adjecent file n y@Comment     (x@(Include i f):xs) = x: adjecent f    i     y xs+adjecent file n y@Comment     (x@(Pre _)      :xs) = x: adjecent file (n+1) y xs+adjecent file n y@Blank       (x@(Include i f):xs) = x: adjecent f    i     y xs+adjecent file n y@Blank       (x@(Pre _)      :xs) = x: adjecent file (n+1) y xs+adjecent file n _             (x@next         :xs) = x: adjecent file (n+1) x xs+adjecent file n _             []                    = []++message "\"\"" n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n"+message []     n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n"+message file   n p c = "In file " ++ file ++ " at line "++show n++": "++p++ " line before "++c++" line.\n"+++-- Re-implementation of 'lines', for better efficiency (but decreased laziness).+-- Also, importantly, accepts non-standard DOS and Mac line ending characters.+inlines s = lines' s id+  where+  lines' []             acc = [acc []]+  lines' ('\^M':'\n':s) acc = acc [] : lines' s id	-- DOS+  lines' ('\^M':s)      acc = acc [] : lines' s id	-- MacOS+  lines' ('\n':s)       acc = acc [] : lines' s id	-- Unix+  lines' (c:s)          acc = lines' s (acc . (c:))+
+ docs/BadInsort.hs view
@@ -0,0 +1,13 @@+sort :: Ord a => [a] -> [a]+-- FAULT (1): missing equation for [] argument+sort (x:xs) = insert x (sort xs)++insert :: Ord a => a -> [a] -> [a]+insert x []     = [x]+insert x (y:ys) = if x <= y+                  -- FAULT (2): y missing from result+		  then x : ys+                  -- FAULT (3): recursive call is same+		  else y : insert x (y:ys)++main = putStrLn (sort "program")
+ docs/Insort.hs view
@@ -0,0 +1,10 @@+sort :: Ord a => [a] -> [a]+sort []     = []+sort (x:xs) = insert x (sort xs)++insert :: Ord a => a -> [a] -> [a]+insert x []     = [x]+insert x (y:ys) = if x <= y then x : y : ys+                  else y : insert x ys++main = putStrLn (sort "program")
+ docs/afp2002.ps.gz view

binary file changed (absent → 108643 bytes)

+ docs/bugs.html view
@@ -0,0 +1,131 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<html><head><title>Hat 2.04 Bugs and Limitations</title></head>+<body text="#000000" bgcolor="#FFFFFF" link="#0000EE" vlink="#551A8B" alink="#FF0000">++<center>+  <img src="hat.gif" alt="Hat Logo"><br>+  <h1>Hat 2.04 Bugs and Limitations</h1>+</center>+<hr>++<p>+This is a list of all known bugs and limitations in Hat 2.04.+There is also a <a href="todo.html">wish-list</a> of features+that we would like to add to Hat.+Please mail+  <a href="mailto:hat@haskell.org">hat@haskell.org</a>+to report any other problems you find.++<h3>hat-trans problems:</h3>+<p>+<ul>+<li><em>hat-trans</em> output fails to compile if the source program+    depends on defaults to resolve numeric types.+    (See <a href="faq.html">FAQ</a> for workaround.)+    </li>+<li><em>hat-trans</em> can fail if the arity of source definitions+    or applications is large.+    (See <a href="faq.html">FAQ</a> for workaround.)+    </li>+<li>Data constructions used in a trusted context are hidden if they are+    evaluated there before the result is demanded in an untrusted+    context.+    </li>+<li><em>hat-trans</em> generates type-incorrect code for FFI declarations+    (foreign imports).+</ul>++<h3>Run-time problems:</h3>+<p>+<ul>+<li>Programs that exhaust memory fail with an incomplete trace file.</li>+</ul>++<h3>Problems with viewing a trace</h3>++<h4>General</h4>+<ul>+<li>List comprehensions and arithmetic ranges+    are not traced at source level: they are recorded and displayed+    in de-sugared form.+    </li>+<li><font color=red>Fixed in Hat 2.04</font>+    <em>do</em> statements are not traced at source level.+    </li>+<li>Super-saturated applications are not shown.+    </li>+<li>Traces involving pattern bindings may be incomplete.+    </li>+<li><font color=red>Fixed in Hat 2.02</font>+    Named fields are not traced at source level.+    </li>+<li><font color=red>Fixed in Hat 2.02</font>+    The viewing tools display some lists misleadingly: when the tail+    of a sugared list is cut off or undefined it is shown as if it+    was a final element.+    </li>+</ul>++<h4>Hat-observe</h4>+<ul>+<li><em>hat-observe</em> inappropriately lists trusted CAFs under :info and+    allows observations of CAF values that should be hidden.+    </li>+<li><em>hat-observe</em> may incorrectly show applications as distinct when+    arguments include a cyclic structure.  (Example program: Cycles)+    </li>+<li>^C in a <em>hat-observe</em> window (to cut short a search) can shut+    down a <em>hat-trail</em> window spawned from the same+    <em>hat-observe</em> session.+    </li>+<li><font color=red>Fixed in Hat 2.02</font>+    After <em>:set recursive off</em> hat-observe shows the non-recursive+    calls of f even if given the application pattern <em>f in f</em>.+    (Example program: ObsRec)+    </li>+<li><font color=red>Fixed in Hat 2.02</font>+    <em>hat-observe</em> :info counts may not match the number of observations+    if there are partial or super-saturated applications.  (Example program:+    MixArity)+    </li>+</ul>++<h4>Hat-trail</h4>+<ul>+<li>If the output is empty, it cannot be selected.+    </li>+<li>The display can become corrupted if output or error message+    from the traced program is wider than the display window.+    </li>+<li><font color=red>Fixed in Hat 2.02</font>+    Scrolling sometimes blanks the upper part of the display when+    the trace is extended and is deeper than the window.  (Example+    program: BigExp)+    </li>+<li><font color=red>Fixed in Hat 2.02</font>+    The display can become corrupted if a single trail expression or+    equation is large enough to scroll off the screen.  (Example+    program: BigExp)+    </li>+</ul>++<h4>Hat-detect</h4>+<ul>+<li><font color=red>Fixed in Hat 2.04</font>+    <em>hat-detect</em> is not currently included with the Hat browsing tools.+    </li>+<li><font color=red>Fixed in CVS version</font>It may assume that an application of a trusted function is OK, even+    if it has suspect children.  Thus, the algorithm to locate the bug+    may occasionally go wrong.+    </li>+<li><font color=red>Fixed in CVS version</font>Only useable for computations that produce faulty output, not for+    computations that abort with an error message or are interrupted.+    </li>+<li><font color=red>Fixed in CVS version</font>Does not work correctly for programs that read input.+    </li>+</ul>++<hr>+<p>+This page last modified: 12th October 2004<br>+</body></html>
+ docs/config.html view
@@ -0,0 +1,175 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<html><head><title>Configuring hat</title></head>+<body bgcolor="#ffffff">+<table><tr><td width=500>++<center>+  <img src="hat.gif" alt="Hat Logo"><br>+  <h1>Configuring hat</h1>+</center>+<hr>++<p>+The automatic configuration and installation utility, called+<em>configure</em>, should always be used to prepare for building and+installing <b>hat</b>.  Unlike many configuration utilities, this+one can be run safely at any time to change any options - it will never+leave your system in an inconsistent state.++<p>+You can choose your own configuration options,+but the default behaviour is to prepare to build the components of+<b>hat</b> under the+<tt>targets</tt> directory, and to install those components under+<tt>/usr/local</tt>, in the subdirectories <tt>bin</tt> (for scripts),+<tt>lib/hat</tt> (for executables and libraries),+<tt>include/hat</tt> (for Hat interface files), and+<tt>man/man1</tt> for man pages.++<p>+Your machine/operating-system is detected and used during building+and installation to ensure that object files and executables from+different architectures do not interfere with each other.  We search+for an existing installation of a Haskell compiler, and <em>hmake</em>,+and configure the build system to use them.  We also guess which+compiler you will use to build <em>hat</em> - in order of preference:+<em>ghc</em>, then <em>nhc98</em>.++<p>+<b>A note about C compilers</b>: If you do not have <em>gcc</em>+as the name of your C compiler (e.g. on MacOS X &le;10.2 , <em>gcc</em> is+called <em>cc</em>), then you need to set the CC environment variable+with the real name of the compiler at configuration time.  For instance:+<pre>    CC=cc  ./configure --buildwith=...</pre>++<hr>+<p>+<em>configure</em> has many options to override the default build and+installation behaviours.  The options fall into three categories, but+they may appear in any order on the command-line.  The first group of+options controls what task <em>configure</em> will do.  You can only+choose one of these - if you choose more than one, only the final one+will take effect.  The other two groups of options are cached and+re-used in later invocations of <em>configure</em>, but you can always+override them on the current commandline.++<dl>+<dt><b>-h</b></dt>+<dt><b>--help</b></dt>+  <dd>Give a brief explanation of all the options.  Do not save any+      configuration settings.</dd>++<dt><b>-v</b></dt>+<dt><b>--version</b></dt>+  <dd>Report package versions.  Do not save any configuration settings.</dd>++<dt><b>--config</b></dt>+  <dd>Set and report configuration options.  [This is the default behaviour+      if no other option from the first group is chosen.]</dd>++<dt><b>--install</b></dt>+  <dd>Install selected components now (scripts, executables, libraries,+      interface files, man pages, html documents etc.).  This option+      should not normally be used - use <tt>make install</tt> instead.+      However for information, it copies the selected components to their+      final directory locations (you must have permission to write into+      those directories).  Don't forget, if you have previously+      run <em>configure</em> with any options set, the previous+      settings will be cached and used for this install - but you can+      override them now on the commandline if you wish.</dd>++</dl>+++<p>+The second and third group of options control the configuration process+and are entirely orthogonal to each other.  The second group configures+some general settings.++<dl>++<dt><b>--buildwith=</b><em>comp</em></dt>+  <dd>Build <em>hat</em> using the named compiler (to override+      the config script's guess).  Possible values are <em>ghc</em>+      or <em>nhc98</em>.</dd>++<dt><b>--buildopts=</b><em>opts</em></dt>+  <dd>Give <em>opts</em> to the build compiler (for instance, to+      force <em>ghc</em> to do optimisation you might add <em>-O</em>).+      </dd>++<dt><b>--builddir=</b><em>dir</em></dt>+  <dd>Use the given base directory for intermediate object files instead of+      the default <tt>./targets</tt>.  This is useful if you have disk+      quotas and need to put object files on a separate temporary disk.</dd>++<dt><b>--installdir=</b><em>rootdir</em></dt>+<dt><b>--prefix=</b><em>rootdir</em></dt>+  <dd>Use the given directory as the installation root instead of the+      default <tt>/usr/local</tt>.</dd>++<dt><b>--bindir=</b><em>dir</em></dt>+  <dd>Use the given directory for installing scripts instead of the+      default directory, <tt>bin</tt> under the installation+      root.</dd>++<dt><b>--libdir=</b><em>dir</em></dt>+  <dd>Use the given directory for installing executables and libraries+      instead of the default directory, <tt>lib/hat</tt> under the+      installation root.</dd>++<dt><b>--incdir=</b><em>dir</em></dt>+  <dd>Use the given directory for installing interface and include files+      instead of the default directory, <tt>include/hat</tt> under the+      installation root.</dd>++<dt><b>--mandir=</b><em>dir</em></dt>+  <dd>Use the given directory for installing manual pages+      instead of the default directory, <tt>man/man1</tt> under the+      installation root.</dd>++<dt><b>--docdir=</b><em>dir</em></dt>+  <dd>Use the given directory for installing the html documentation+      instead of the default directory, <tt>/usr/doc/hat</tt>.</dd>++</dl>+++<p>+Finally, the third group of options allows you to select which+components of the package you wish to install.  They can be useful when+installing the same software for many architectures on a heterogeneous+network, if you don't want to continually re-install shared components+such as man pages.  As another example, you may want to update just the+scripts from a new beta release, without re-installing the executables.++<dl>+<dt><b>[+/-]lib</b></dt>+  <dd>Do (or don't) install the executables and library files (default is +).</dd>+<dt><b>[+/-]inc</b></dt>+  <dd>Do (or don't) install the include and interface files (default is +).</dd>+<dt><b>[+/-]bin</b></dt>+  <dd>Do (or don't) install the scripts (default is +).</dd>+<dt><b>[+/-]man</b></dt>+  <dd>Do (or don't) install the man pages (default is +).</dd>+<dt><b>[+/-]docs</b></dt>+  <dd>Do (or don't) install the html documents (default is -).</dd>+</dl>+++<hr>+<p>+The latest updates to these pages are available on the WWW from+<a href="http://www.haskell.org/hat/">+<tt>http://www.haskell.org/hat/</tt></a><br>+<a href="http://www.cs.york.ac.uk/fp/hat/">+<tt>http://www.cs.york.ac.uk/fp/hat/</tt></a>++<p>+This page last modified: 15th August 2002<br>+<a href="http://www.cs.york.ac.uk/fp/">+York Functional Programming Group</a><br>++</td></tr></table>+</body></html>+
+ docs/copyright.html view
@@ -0,0 +1,180 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<html><head><title>Hat copyright</title></head>+<body bgcolor="#ffffff">+<table><tr><td width=500>++<center>+  <img src="hat.gif" alt="Hat">+  <h1>Hat copyright information</h1>+</center>+<hr>++<p>+Development of the Hat tracing system was mainly funded by the UK's+Engineering and Physical Sciences Research Council, grant number+EPSRC GR/M81953.  The University of York, University of Kent, RWTH+Aachen, and Microsoft Research (Cambridge) also contributed.++<p>+The Hat system as a whole was developed (mainly) at, and is copyright+&copy; The University of York, 1996-2005.++<p>+The <em>hat-trans</em> tool is partly based on the front end of the+<em><a href="http://haskell.org/nhc98">nhc98</a></em> compiler, and+those parts are copyright &copy; Niklas R&ouml;jemo, 1991-1998.+Parts are also based on earlier work on tracing transformations,+copyright &copy; Jan Sparud and Colin Runciman, 1996-1997.++<p>+<em>hat-trans</em> is+&copy; copyright to Olaf Chitil and Malcolm Wallace, 2002-2005.+<p>+<em>hat-observe</em> is+&copy; copyright to Malcolm Wallace and Thorsten Brehm, 2001-2004.+<p>+<em>hat-detect</em> is+&copy; copyright to Malcolm Wallace and Thorsten Brehm, 2001-2004.+<p>+<em>hat-trail</em> is+&copy; copyright to Malcolm Wallace, 2002-2004.+<p>+<em>hat-stack</em> is+&copy; copyright to Malcolm Wallace, 2001-2004.+<p>+<em>hat-check</em> is+&copy; copyright to Colin Runciman, 2001-2004.+<p>+<em>hat-cover</em> is+&copy; copyright to Colin Runciman, 2004.+<p>+<em>hat-explore</em> is+&copy; copyright to Olaf Chitil, 2004-2005.+<p>+<em>hat-anim</em> is+&copy; copyright to Thomas Davie, 2004-2005.+<p>+<em>hat-nonterm</em> is+&copy; copyright to Mike Dodds, 2004.+<p>+<em>black-hat</em> is+&copy; copyright to Mike Dodds, 2004.++<p>+The Hat tools are distributed under the terms of the+licence detailed below.  If you link the Hat tools with the <a+href="http://www.gtk.org/">gtk+</a> library <em>glib</em>, you should+know that <em>glib</em> is governed by the LGPL.++<p>+Some code from the libraries is copied directly from the+Haskell hierarchical libraries base package, which is+&copy; copyright the University of Glasgow, 2001-2004+and was originally distributed under a separate BSD-style licence.+++<center>+<hr>+<h3>LICENCE</h3>+</center>+<p>+<b>Definition:</b>+<ul>+<li> "this software" = any software which is distributed under+                              the conditions of this licence.+<li> "small number of modules" = less than 10% of any one program+</ul>++<p>+It is the intention that this software be "freely available" in the Gnu+(<a href="http://www.gnu.org/"><tt>http://www.gnu.org/</tt></a>)+and Open Source+(<a href="http://www.opensource.org/"><tt>http://www.opensource.org/</tt></a>)+traditions.+The following is a brief statement of the rights and restrictions+attached to this software distribution.  This is version 2 of the+licence, and governs this copy of the software.  We may publish+modified terms and conditions at a later date, and if you wish, you+may apply any successor licence (when published), or the GNU GPL,+to this software as an alternative to the current terms.  (Note that+if you convert your copy of the licence to the GPL, you will not be+able to convert it back later, and nor can anyone who receives a copy+from you.)++<p>+If you are not sure about any of the terms of this licence,+please contact us to discuss your requirements.  (Primary contact:+Malcolm.Wallace@cs.york.ac.uk)++<p>+You may use, re-distribute, and modify this software, in whole or+in part, in source or binary form, but you must include without+alteration all the relevant copyright notices.  (You may of course+remove a copyright notice pertaining to a piece of software no longer+included in your distribution.)  You may add your own additional+copyright notices for any modifications or additions to this software+that you distribute.  If you distribute a modified version, you must+also provide corresponding source code for it; any modifications must+be described in the documentation; and you must clearly indicate that+the software has been modified, for instance by changing the name of+the executable or its version number, or by some other method.++<p>+You must not restrict anyone else's rights to use, re-distribute or+modify this software.  Distributions of standard or modified versions+of this software must retain this licence (or its successor), or at+your choice, be distributed instead under the GNU GPL.++<p>+In addition, you are explicitly granted the right to re-use a small+number of modules of this software in the creation of a new program+which does not perform substantially the same task as this software,+for instance, by re-using a parser but not the entire compiler.+In such a case, you are not forced to place the new software under+this or any other licence, but you must ensure that:+<ul>+ <li> you clearly acknowledge which code you have re-used from this software,+ <li> you retain the relevant copyright notices, and+ <li> if you distribute the new software, you indicate to recipients where+      they can freely obtain a standard version of this original software.+</ul>++<p>+Object files, intermediate files, and trace files, produced as output+by this software do not fall under this copyright statement and are+not governed by the terms of this licence.  You are free to use them+(or restrict their use) as you like.  However, the inclusion of+Hat's runtime system (libHSHat.a) in a resulting executable, means+that you may not distribute that executable except under the terms+of this licence.  (We can't see any reason why anyone would want to+distribute a traced version of their program anyway - but if this+is a problem for you, contact us.  Also, you should check carefully+the licence of any other library you use in your traced program,+whether supplied together with this software or not.)+++<p>+UNLESS OTHERWISE STATED IN WRITING, THIS SOFTWARE IS SUPPLIED "AS IS"+AND WITHOUT ANY WARRANTY, EXPRESS OR IMPLIED, INCLUDING WITHOUT+LIMITATION THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A+PARTICULAR PURPOSE.  NEITHER THE AUTHORS, COPYRIGHT HOLDERS, NOR ANY+OTHER PARTY WHO REDISTRIBUTES THIS SOFTWARE SHALL BE LIABLE FOR DAMAGES,+HOWSOEVER CAUSED, ARISING OUT OF THE USE OF THIS SOFTWARE.  USE AT YOUR+OWN RISK.++<hr>+<p>+The latest updates to these pages are available on the WWW from+<a href="http://www.haskell.org/hat/">+<tt>http://www.haskell.org/hat/</tt></a><br>+<a href="http://www.cs.york.ac.uk/fp/hat/">+<tt>http://www.cs.york.ac.uk/fp/hat/</tt></a>++<p>+This page last updated: 17th May 2005<br>+<a href="http://www.cs.york.ac.uk/fp/">+York Functional Programming Group</a><br>++</td></tr></table>+</body></html>+
+ docs/cvs.html view
@@ -0,0 +1,151 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<html><head><title>Hat in CVS</title></head>+<body bgcolor=#ffffff>+<table><tr><td width=500>++<center>+  <h1>CVS access to Hat</h1>+</center>+<hr>++<p>+This page tells you how to get CVS access to the latest, most current,+<em>Hat</em> sources.+++<h3>Remote Read-only CVS Access</h3>++<p>+Read-only access is available to anyone - there's no need to ask us+first.  To get read-only access to the repository:++<ul>+<li> Obviously, you need to have the <em>cvs</em> command installed.+<li> The first time you access the repository, you'll need to do+     the following:+<pre>+      $ cvs -d :pserver:anoncvs@cvs.haskell.org:/cvs login+      Password: cvs+</pre>+     You only need to supply the password once, because cvs will squirrel+     it away for future use in $HOME/.cvspass.++<li> To checkout the hat sources, use this command:+<pre>+      $ cvs -d :pserver:anoncvs@cvs.haskell.org:/cvs checkout hat+</pre>+     The checked-out source tree will appear in a directory called+     <tt>hat</tt>.  You can rename this directory to whatever you+     like, CVS won't mind.+<li> From then on, you should no longer need the <em>-d blah</em> option,+     and commands like+<pre>+      $ cvs diff+      $ cvs update+</pre>+     should work, provided your working directory is somewhere inside+     the checked out tree.  In normal use, <tt>cvs update</tt>+     is the command to merge the latest changes from the central+     repository into your local tree.  <tt>cvs diff</tt> gives you+     the differences between your version and the central version.+<li> If you change your current directory into a sub-directory of the+     CVS tree, cvs commands will normally operate only on that subtree,+     not on the full tree.  This is very handy if you are only interested+     in a small part of the source.+</ul>++<p>+With read-only CVS access you can do anything except commit changes+to the repository. You can make changes to your local tree, and still+use CVS's update facility to keep your tree otherwise up-to-date,+and you can generate patches using <tt>cvs diff</tt> in order to send+to us for inclusion.++<p>+To set up default flags for some of the CVS commands, you can create+a <tt>.cvsrc</tt> file.  For instance, the -P flag to 'update' says+prune empty directories, which is normally what you want, and the -d+flag ensures that you collect new directories that have been added.+Here is an example <tt>.cvsrc</tt> file:+<pre>+        checkout -P+        release -d+        update -d -P+        diff -c+</pre>++<h3>Using the checked-out CVS tree</h3>++<p>+The first thing to do after checking out a fresh tree is+<tt>./configure</tt>, setting whatever options you wish to use.+It is always safe to re-run the <tt>./configure</tt> script at any+time - it will never leave your configuration in an inconsistent state.+The machine/OS combination is always detected first so you can't re-use+the wrong machine configuration by mistake, and although previous+options for a particular machine are cached, they are always reported,+and can be always overridden on the command line.++<p>+Then, do a <tt>make</tt> with whatever targets you are interested+in: <tt>make help</tt> will give you a list of the common ones.+For instance, <tt>make hat</tt> gives you everything, but <tt>make+hat-tools</tt> gives you just the browsing tools.+++<h3>Tracking changes in the CVS repository</h3>+<p>+The log messages of all CVS commit actions are currently sent to the+mailing list <tt>cvs-nhc98@haskell.org</tt>.  If you wish to see who+is making changes, why, and and what they say about them, please do+join this list - see <a href="http://haskell.org/mailman/listinfo">+<tt>http://haskell.org/mailman/listinfo</tt></a> for further details.+++<h3>Core developers - write-access to CVS</h3>+<p>+Core developers of <em>hat</em> have write-access to the CVS+repository.  They need to use a slightly different procedure for+accessing the source tree:++<ul>+<li> You need to have <em>ssh</em> (secure shell) installed.+<li> Set your CVS_RSH environment variable to <tt>ssh</tt>.+<li> The first time you access the repository, you'll need to do+     the following:+<pre>+      $ cvs -d :ext:<em>username</em>@cvs.haskell.org:/home/cvs/root checkout hat+</pre>+</ul>++<p>+All the other instructions are the same, except that developers also+have permission to commit changes to the repository.++<h3>Gaining write-access</h3>+<p>+To obtain write-access to cvs.haskell.org, you need to ask the+Haskell CVS maintainer - Jeff Lewis &lt;jlewis@galconn.com&gt; - for+an account.  The details are on the+<a href="http://www.haskell.org/ghc/docs/latest/html/building/sec-cvs.html">+GHC CVS cheat-sheet</a> (Section 2.1.2).++++<p>+<hr>+<p>+The latest updates to these pages are available on the WWW from+<a href="http://www.haskell.org/nhc98/">+<tt>http://www.haskell.org/nhc98/</tt></a><br>+<a href="http://www.cs.york.ac.uk/fp/nhc98/">+<tt>http://www.cs.york.ac.uk/fp/nhc98/</tt></a>++<p>+This page last modified: 13th March 2003<br>+<a href="http://www.cs.york.ac.uk/fp/">+York Functional Programming Group</a><br>++</td></tr></table>+</body></html>+
+ docs/darcs.html view
@@ -0,0 +1,124 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<html><head><title>Hat in darcs</title></head>+<body bgcolor=#ffffff>+<table><tr><td width=500>++<center>+  <h1>Developer access to Hat</h1>+</center>+<hr>++<p>+This page tells you how to get <a href="http://darcs.net">darcs</a>+access to the latest, most current, <em>Hat</em> sources.+++<h3>Viewing the darcs repository on the web</h3>+<p>+If you don't want to download the sources, you can view the current+contents of the repository on the web+<a href="http://darcs.haskell.org/darcsweb/">here</a>.+++<h3>Remote Read-only Access</h3>++<p>+Read-only access is available to anyone - there's no need to ask us+first.  To get read-only access to the repository:++<ul>+<li> Obviously, you need to have the <em>darcs</em> command installed.+<li> <tt>darcs get --partial http://darcs.haskell.org/hat</tt>+<li> If you want the complete history, omit the <tt>-partial</tt> flag,+     but be warned that the history is large, it will take a long time+     to download, and will have errors on case-insensitive file systems+     (e.g. Windows and MacOS X).+<li> The checked-out source tree will appear in a directory called+     <tt>hat</tt>.  You can rename this directory to whatever you+     like, darcs won't mind.+<li> Change to that directory, and run the shell script <tt>sh start</tt>.+     This will prepare the repository for use, by making various scripts+     executable, possibly downloading extra library packages, and so on.+<li> From then on, you can keep up with new changes in the central repo+     by using <tt>darcs-all pull</tt>.  You can even do your own+     development in a detached fashion, using <tt>darcs record</tt> on+     your own local repository.+</ul>++<p>+With read-only CVS access you can do anything except commit changes+to the central repository.  You can <tt>darcs record</tt> changes+in your local tree, then submit them to us by email using <tt>darcs+send</tt>.+++<h3>Using the checked-out tree</h3>++<p>+The first thing to do after checking out a fresh tree is+<tt>sh start</tt>, followed by+<tt>./configure</tt>, and setting whatever options you wish to use.+It is always safe to re-run the <tt>./configure</tt> script at any+time - it will never leave your configuration in an inconsistent state.+The machine/OS combination is always detected first so you can't re-use+the wrong machine configuration by mistake, and although previous+options for a particular machine are cached, they are always reported,+and can be always overridden on the command line.++<p>+Then, do a <tt>make</tt> with whatever targets you are interested+in: <tt>make help</tt> will give you a list of the common ones.+For instance, <tt>make hat</tt> gives you everything, but <tt>make+hat-tools</tt> gives you just the browsing tools.+++<h3>Tracking changes in the central repository</h3>+<p>+The log messages of all accepted darcs patches are currently sent to the+mailing list <tt>cvs-nhc98@haskell.org</tt>.  If you wish to see who+is making changes, why, and and what they say about them, please do+join this list - see <a href="http://haskell.org/mailman/listinfo">+<tt>http://haskell.org/mailman/listinfo</tt></a> for further details.+++<h3>Core developers - write-access to the central repository</h3>+<p>+Core developers of <em>hat</em> have write-access to the central+darcs repository.  All you need is an account on the machine+<tt>darcs.haskell.org</tt>.++<ul>+<li> You need to have <em>ssh</em> (secure shell) installed.+<li> The first time you commit a patch back to the repo, you will+     need to specify where it is located:+    <pre>darcs push darcs..haskell.org:/home/darcs/hat</pre>+<li> Thereafter, just use <tt>darcs push</tt> to commit patches.+</ul>++<p>+All the other instructions are the same.++<h3>Gaining write-access</h3>+<p>+To obtain write-access to darcs.haskell.org, you need to ask the+haskell.org maintainers - Simon Marlow &lt;simonmar@haskell.org&gt; or+Isaac Jones &lt;ijones@galois.com&gt; - for an account.+++<p>+<hr>+<p>+The latest updates to these pages are available on the WWW from+<a href="http://www.haskell.org/hat/">+<tt>http://www.haskell.org/nhc98/</tt></a><br>+<a href="http://www.cs.york.ac.uk/fp/hat/">+<tt>http://www.cs.york.ac.uk/fp/nhc98/</tt></a>++<p>+This page last modified: 10th October 2006<br>+<a href="http://www.cs.york.ac.uk/fp/">+York Functional Programming Group</a><br>++</td></tr></table>+</body></html>+
+ docs/download.html view
@@ -0,0 +1,270 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<html><head><title>Hat download page</title></head>+<body bgcolor="#ffffff">+<table><tr><td width=530>++<center>+  <img src="hat.gif" alt="Hat Logo"><br>+  <h1>Hat download page</h1>+</center>++<hr>++<p>+The latest stable release of Hat is 2.06, available in various+distribution formats (listed below).  Important patches for the stable+version are also provided (at the bottom of the page).  The development+tree is at version 2.07 and is mainly available via+<a href="darcs.html">darcs</a>.++<p>+Bugfixes and important changes to the system are described in the+<a href="status.html">release notes</a> for each version.++<p>+Don't forget to read the <a href="requirements.html">system requirements</a>,+first, and then the <a href="install.html">installation instructions</a>.++<p>+<hr>++<h3>Distribution packages</h3>++<p>+<center>+<table width=450 border=1 cellspacing=0 cellpadding=2>+<tr bgcolor="#dddddd"><th>package</th> <th>machine</th>+                    <th>version</th> <th>date</th> <th>size</th></tr>++<tr bgcolor="#ddffdd">+  <td><a href="ftp://ftp.cs.york.ac.uk/pub/haskell/hat/hat-2.06.tar.gz">+      Sources (.tar.gz)</a></td>+  <td>any</td>+  <td><font color=red>2.06</font></td>+  <td>2008-10-2</td>+  <td>1.6Mb</td></tr>++<tr bgcolor="#ddffdd">+  <td><a href="ftp://ftp.cs.york.ac.uk/pub/haskell/hat/hat-2.05.tar.gz">+      Sources (.tar.gz)</a></td>+  <td>any</td>+  <td><font color=red>2.05</font></td>+  <td>2006-10-23</td>+  <td>1.6Mb</td></tr>++<tr bgcolor="#ddffdd">+  <td><a href="ftp://ftp.cs.york.ac.uk/pub/haskell/hat/hat-2.04.tar.gz">+      Sources (.tar.gz)</a></td>+  <td>any</td>+  <td><font color=red>2.04</font></td>+  <td>2005-05-17</td>+  <td>1.6Mb</td></tr>++<tr bgcolor="#ffffdd">+  <td><a href="ftp://ftp.cs.york.ac.uk/pub/haskell/hat/hat-2.02.tar.gz">+      Sources (.tar.gz)</a></td>+  <td>any</td>+  <td><font color=red>2.02</font></td>+  <td>2003-03-26</td>+  <td>1.4Mb</td></tr>++<tr bgcolor="#ffdddd">+  <td><a href="ftp://ftp.cs.york.ac.uk/pub/haskell/hat/old/hat-2.00.tar.gz">+      Sources (.tar.gz)</a></td>+  <td>any</td>+  <td><font color=red>2.00</font></td>+  <td>2002-06-14</td>+  <td>1.5Mb</td></tr>++</table>+</center>++<p>+<em><b>Alternative locations:</b></em>+<br>+<b>Tarfiles and RPMs:</b><br>+<a href="ftp://ftp.cs.york.ac.uk/pub/haskell/hat/">+<tt>ftp://ftp.cs.york.ac.uk/pub/haskell/hat/</tt></a><br>+<a href="http://www.cs.york.ac.uk/fp/hat/hat-2.06.tar.gz">+<tt>http://www.cs.york.ac.uk/fp/hat/hat-2.06.tar.gz</tt></a><br>+<b>RPMs for RedHat:</b><br>+<a href="http://www.dtek.chalmers.se/~d95mback/nhc98/">+<tt>http://www.dtek.chalmers.se/~d95mback/nhc98/</tt></a><br>+<a href="http://haskell.org/~petersen/rpms/i386/">+<tt>http://haskell.org/~petersen/rpms/i386/</tt></a><br>+<a href="http://haskell.org/~petersen/srpms/">+<tt>http://haskell.org/~petersen/srpms/</tt></a><br>+<b>FreeBSD port:</b><br>+<a href="http://freshports.org/devel/hs-hat/">+<tt>http://freshports.org/devel/hs-hat/</tt></a><br>+<b>Darwin port:</b><br>+<a href="http://darwinports.opendarwin.org/">+<tt>http://darwinports.opendarwin.org//</tt></a><br>+<b>Debian packages:</b><br>+<a href="ftp://ftp.debian.org/debian/pool/main/h/hat/">+<tt>ftp://ftp.debian.org/debian/pool/main/h/hat/</tt></a><br>++<hr>++<p>+<center>+<b>Known to work with the following compiler versions upwards:</b><br>+<table border=1 cellspacing=0 cellpadding=2 bgcolor="#dddddd"><tr>+<td>nhc98</td><td>1.18</td>+</tr><tr>+<td>ghc</td><td>5.04.2</td>+</tr><tr>+<td>ghc</td><td>6.0.1</td>+</tr></table>+</center>++<p>++<p>+All the documents available on the web are included in the source package.+(* Please note that options/instructions for out-of-date packages+may differ slightly from the ones on the web.  Always follow the+instructions from the package itself.)++<p>+The <a href="install.html">installation instructions</a> should+be comprehensive, but if you have any problems, please mail+<a href="mailto:hat@haskell.org"><tt>hat@haskell.org</tt></a>.+(You do not need to be a member of the list to post to it.)++<br><br><hr>+<h3>Patches</h3>+<center>+<table width=450 border=1 cellspacing=0 cellpadding=2>+<tr bgcolor="#dddddd"><th>patch name</th> <th>patch to</th>+                    <th>date</th> <th>fixes what problem?</th></tr>++<tr bgcolor="#ddffdd">+  <td><a href="ftp://ftp.cs.york.ac.uk/pub/haskell/hat/patch-2.04-config">+      config</a></td>+  <td>hat v2.04</td>+  <td>2006-05-25</td>+  <td>Several small configuration fixes for building Hat with+      ghc-6.4 and/or gcc-4.x compilers.+      </td></tr>++<tr bgcolor="#ddffdd">+  <td><a href="ftp://ftp.cs.york.ac.uk/pub/haskell/hat/patch-2.04-dirs">+      -Idirs</a></td>+  <td>hat v2.04</td>+  <td>2005-07-04</td>+  <td>This patch fixes the directory and file names generated by hat-trans+      when the original source code is referenced by an upward relative path+      such as <tt>../../code</tt>.  This can particularly occur if you use a+      <tt>-Idir</tt> or <tt>-idir</tt> option to hmake.+      </td></tr>++<tr bgcolor="#ddffdd">+  <td><a href="ftp://ftp.cs.york.ac.uk/pub/haskell/hat/hat.cabal">+      cabal file</a></td>+  <td>hat v2.04</td>+  <td>2005-07-04</td>+  <td>A replacement for the file <tt>src/hatlib/hat.cabal</tt>,+      exposing more of internal modules of Hat.  This is needed if you+      encounter an error like "Could not find module `Hat.PreludeBuiltin'"+      </td></tr>++<tr bgcolor="#ddffdd">+  <td><a href="ftp://ftp.cs.york.ac.uk/pub/haskell/hat/patch-2.04-patbind">+      patbind</a></td>+  <td>hat v2.04</td>+  <td>2005-06-29</td>+  <td>A patch to fix the translation of pattern-bindings at the toplevel.+      </td></tr>++<tr bgcolor="#ffffdd">+  <td><a href="ftp://ftp.cs.york.ac.uk/pub/haskell/hat/patch-2.02-cumulative">+       cumulative</a></td>+  <td>hat v2.02</td>+  <td>2003-04-30</td>+  <td>This patch is a cumulative patch that includes the two listed below+      (redefine and typesyn), and in addition fixes the following problem:+      In the transformation of a module that defines instances of an+      imported class whose methods are only in scope qualified, any+      generated uses of the method names must be qualified too.+      </td></tr>++<tr bgcolor="#ffffdd">+  <td><a href="ftp://ftp.cs.york.ac.uk/pub/haskell/hat/patch-2.02-redefine">+       redefine</a></td>+  <td>hat v2.02</td>+  <td>2003-04-24</td>+  <td>A Prelude entity redefined in a user module led to some overlapping+      auxiliary functions in the hat-transformed module.  This patch+      ensures that a Prelude function is not imported if there is a+      local redefinition.+      </td></tr>++<tr bgcolor="#ffffdd">+  <td><a href="ftp://ftp.cs.york.ac.uk/pub/haskell/hat/patch-2.02-typesyn">+       typesyn</a></td>+  <td>hat v2.02</td>+  <td>2003-04-24</td>+  <td>Some complex type synonyms (renaming arrow (function) types)+      led to incorrect types in the hat-transformed code.+      </td></tr>++<tr bgcolor="#ffdddd">+  <td><a href="ftp://ftp.cs.york.ac.uk/pub/haskell/hat/old/patch-2.00-hmake3.06">+       hmake3.06</a></td>+  <td>hat v2.00</td>+  <td>2002-10-14</td>+  <td>Enable hat-trans to build with the latest version of hmake (3.06).+      </td></tr>++<tr bgcolor="#ffdddd">+  <td><a href="ftp://ftp.cs.york.ac.uk/pub/haskell/hat/old/patch-2.00-pp">+       pretty-printer</a></td>+  <td>hat v2.00</td>+  <td>2002-08-28</td>+  <td>Fix a pretty-printing bug in hat-trans, e.g. the transformed version+      of <tt>f = \ ~(a,b) -&gt; 1</tt> was printed wrongly.+      </td></tr>++<tr bgcolor="#ffdddd">+  <td><a href="ftp://ftp.cs.york.ac.uk/pub/haskell/hat/old/patch-2.00-ntohl">+       ntohl</a></td>+  <td>hat v2.00</td>+  <td>2002-07-12</td>+  <td>On some machines (e.g. Solaris), an extra #include is needed to+      get hold of the ntohl() macro.+      </td></tr>++<tr bgcolor="#ffdddd">+  <td><a href="ftp://ftp.cs.york.ac.uk/pub/haskell/hat/old/echo.c">+       script/echo.c</a></td>+  <td>hat v2.00</td>+  <td>2002-06-19</td>+  <td>This file is missing from the distribution tarfile.  You will+      only need it on platforms where the builtin `echo' command does+      not understand the `-n' option.+      </td></tr>++</table>+</center>+++<br><br>+++<hr>+<p>+The latest updates to these pages are available on the WWW from+<a href="http://www.haskell.org/hat/">+<tt>http://www.haskell.org/hat/</tt></a><br>+<a href="http://www.cs.york.ac.uk/fp/hat/">+<tt>http://www.cs.york.ac.uk/fp/hat/</tt></a>++<p>+This page last modified: 2nd Oct 2008<br>+<a href="http://www.cs.york.ac.uk/fp/">+York Functional Programming Group</a><br>++</td></tr></table>+</body></html>+
+ docs/faq.html view
@@ -0,0 +1,122 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<html><head><title>Hat - FAQ</title></head>+<body text="#000000" bgcolor="#FFFFFF" link="#0000EE" vlink="#551A8B" alink="#FF0000">++<center>+  <img src="hat.gif" alt="Hat Logo"><br>+  <h1>Hat</h1>+  <h2>Frequently Asked Questions</h2>+</center>+<hr>+++<h3>Why do you call Hat a <em>tracer</em> rather than a <em>debugger</em>?</h3>++<p>+The word <em>debugger</em> suggests: firstly that there is a fault to be+found; and secondly, that the tool will fix it.  In actual fact, the+tracer is just a tool for observing what happened in any particular+program run.  You can use it to find the cause of a fault, but equally,+you can use it simply to aid your understanding of a correct program.+While the tracer will help you to find bugs, it cannot find them for+you.  And once the bug is found, <em>you</em> must fix it, the tracer+cannot!++<h3>Why did you not implement a conventional tracer/debugger as they+are well known for imperative languages?</h3>++<p>+Conventional tracers (debuggers) for imperative languages allow the+user to step through the program computation, stop at given points+and examine variable contents.  In our opinion this tracing method is+unsuitable for a lazy functional language such as Haskell, because its+evaluation order is complex, function arguments are usually unwieldy+large unevaluated expressions, and generally computation details do+not match the user's high-level view of functions mapping values+to values.  Also the stack used by the Haskell runtime system does+not resemble the stack of function calls used by runtime systems of+strict languages.++<p>+However, the trace file written by the traced program contains all+information in the order of lazy evaluation. It is possible to write+a viewing tool that admits single stepping through a lazy computation.++<h3>How much does tracing cost me in time and space?</h3>++<p>+Currently a traced program runs between 50-150 times slower than+its untraced counterpart, depending which compiler and options you+use.  We are working on reducing this factor.  As a rule of thumb,+a reduction step produces about 50 bytes in the trace file.  So trace+files can easily grow to tens and hundreds of megabytes. However,+you can name some modules of your program as <em>trusted</em>, so+that their reductions are not recorded in the trace.++<h3>I don't seem to be able to build Hat-2.02 with ghc-6.x</h3>++<p>+The hat-2.02 package is quite old now and does not build cleanly with+ghc &ge; 6.0.  All the build problems with ghc-6.x are fixed in the+newer release hat-2.04.++<h3>I have trouble compiling my program for tracing.</h3>++<p>+Hat covers the complete Haskell'98 language and its libraries, or+at least that is the intention.  It also supports a few language+extensions, such as the FFI, multi-parameter type class, functional+dependencies, and so on.  First make sure that your program is suitable+for tracing with Hat [ check our <a href="feature-table.html">Feature+Summary</a> to see exactly which language extensions are supported ],+and if it still won't compile, report it as a bug in Hat.++<h3>Compiling for tracing gives me an error like: Ambiguous type+variable `a' in top-level constraint `Num a'</h3>++<p>+You have been hit by Haskell's defaulting rules for numeric literals,+which unfortunately means you need to add one or more type signatures+to your code.  In the rejected module, add the line "default ()",+and recompile it normally (not for tracing).  You will now see an+error of similar form to the error you saw when compiling for tracing,+except that the line number refers to your original code.  Fix this+error by adding a type signature, e.g. (0::Int) instead of just 0.+Now if your original code compiles cleanly again, it will also compile+properly for tracing.++<h3>hat-trans fails with an error like: Cannot handle field update with+more than 2 labels; attempted arity 11</h3>++<p>+Hat has some numeric limits on the size of certain constructs it+can handle.  Usually, there is a simple syntactic change you can make+to your original source code to get round the limitation.  For instance:+<ul>+<li> <em>Field updates.</em> You can re-write a large field update+  to become a chain of smaller field updates, each with no more than+  two labels.  e.g. change <pre>x { a=1, b=2, c=3, d=4, e=5 }</pre>+  to <pre>x { a=1, b=2 } { c=3, d=4 } { e=5 }</pre>++<li> <em>Large applications.</em> You can re-write a large function or+  constructor application using parentheses to become a chain of smaller+  nested applications, each with no more than the stated arity.  e.g. change+  <pre>f a b c d e g h i j k</pre> to <pre>(((f a b c d) e g h i) j k</pre>+</ul>+++<p>+<hr>+The latest updates to these pages are available on the WWW from+<a href="http://www.haskell.org/hat/">+<tt>http://www.haskell.org/hat/</tt></a><br>+<a href="http://www.cs.york.ac.uk/fp/hat/">+<tt>http://www.cs.york.ac.uk/fp/hat/</tt></a>++<p>+This page last modified: 12th October 2004<br>+<a href="http://www.cs.york.ac.uk/fp/">+York Functional Programming Group</a><br>++</body></html>+
+ docs/feature-table.html view
@@ -0,0 +1,169 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<html>+<head><title>Hat feature summary</title></head>+<body bgcolor=white text=black>++<center><h1>How complete is Hat?</h1></center>++<p>+<center>+<em>Key:</em><br>+<b>-</b> = no support<br>+<b>+</b> = partial support<br>+<b>*</b> = full support<br>+</center>++<p>+"Partial" support of a language feature means that you <em>will</em>+be able to trace programs using this feature, but that the traces+may not be in convenient source-level terms.  Partial support of a+library or type-system feature means that some programs <em>may</em>+trace OK, but others might not.++<p>+<table cellspacing=20 width=100% border=1><tr width=100%><td width=50% valign=top>++<table cellspacing=0 border=0>+<tr>+<th>feature</th><th>Hat (2.04)</th>+</tr><tr>++<td colspan=2><hr></td>+</tr><tr>+<th colspan=2>Language constructs</th>+</tr><tr>+<td>modules</td><td align=center>*</td>+</tr><tr>+<td>lambda abstractions</td><td align=center>*</td>+</tr><tr>+<td>pattern matches</td><td align=center>*</td>+</tr><tr>+<td>guards</td><td align=center>*</td>+</tr><tr>+<td>if-then-else</td><td align=center>*</td>+</tr><tr>+<td>case expr of</td><td align=center>*</td>+</tr><tr>+<td>list comprehensions</td><td align=center>+</td>+</tr><tr>+<td>monadic do</td><td align=center>+</td>+</tr><tr>+<td>infix operators</td><td align=center>*</td>+</tr><tr>+<td>numeric literals</td><td align=center>*</td>+</tr><tr>+<td>numeric sequences</td><td align=center>+</td>+</tr><tr>+<td>n+k patterns</td><td align=center>*</td>+</tr><tr>++<th colspan=2>Basic types</th>+</tr><tr>+<td>Bool</td><td align=center>*</td>+</tr><tr>+<td>Char</td><td align=center>*</td>+</tr><tr>+<td>List</td><td align=center>*</td>+</tr><tr>+<td>Tuples</td><td align=center>*</td>+</tr><tr>+<td>Int</td><td align=center>*</td>+</tr><tr>+<td>Integer</td><td align=center>*</td>+</tr><tr>+<td>Float</td><td align=center>*</td>+</tr><tr>+<td>Double</td><td align=center>*</td>+</tr><tr>+<td>Rational</td><td align=center>*</td>+</tr><tr>++<th colspan=2>User types</th>+</tr><tr>+<td>data types</td><td align=center>*</td>+</tr><tr>+<td>type synonyms</td><td align=center>*</td>+</tr><tr>+<td>newtypes</td><td align=center>*</td>+</tr><tr>+<td>named fields</td><td align=center>*</td>+</tr><tr>+<td>type classes</td><td align=center>*</td>+</tr><tr>+<td>derived instances</td><td align=center>*</td>+</tr><tr>+<td>strict types</td><td align=center>*</td>++</tr>+</table>++</td><td width=50% valign=top>++<table cellspacing=0 border=0>+<tr>+<th>feature</th><th>Hat (2.04)</th>+</tr><tr>++<td colspan=2><hr></td>+</tr><tr>+<th colspan=2>Input/output</th>+</tr><tr>+<td>single I/O streams</td><td align=center>*</td>+</tr><tr>+<td>file handling</td><td align=center>+</td>+</tr><tr>++<th colspan=2>Libraries</th>+</tr><tr>+<td>Haskell'98 Prelude</td><td align=center>*</td>+</tr><tr>+<td>Haskell'98 Libraries</td><td align=center>*</td>+</tr><tr>+<td>base hierarchical libraries</td><td align=center>+</td>+</tr><tr>+<td>other hierarchical libraries</td><td align=center>-</td>+</tr><tr>++<th colspan=2>Platform Portability</th>+</tr><tr>+<td>machine and O/S</td><td align=center>*</td>+</tr><tr>+<td>nhc98</td><td align=center>*</td>+</tr><tr>+<td>ghc</td><td align=center>*</td>+</tr><tr>+<td>hugs</td><td align=center>-</td>+</tr><tr>+<td>hbc</td><td align=center>-</td>+</tr><tr>+<td>helium</td><td align=center>-</td>+</tr><tr>++<th colspan=2>Non-Haskell'98 Extensions</th>+</tr><tr>+<td>primitive FFI</td><td align=center>+</td>+</tr><tr>+<td>hierarchical library namespace</td><td align=center>*</td>+</tr><tr>+<td>unsafePerformIO etc</td><td align=center>*</td>+</tr><tr>+<td>multi-parameter TCs</td><td align=center>*</td>+</tr><tr>+<td>functional dependencies</td><td align=center>*</td>+</tr><tr>+<td>existential types</td><td align=center>+</td>+</tr><tr>+<td>implicit parameters</td><td align=center>-</td>+</tr><tr>+<td>imprecise exceptions</td><td align=center>+</td>+</tr><tr>+<td>concurrency</td><td align=center>-</td>+</tr><tr>+<td>parallelism</td><td align=center>-</td>++</tr>+</table>++</td></tr></table>++</body></html>
+ docs/frejaHatHood.ps.gz view

binary file changed (absent → 85954 bytes)

+ docs/hat-trail-1.eps view
@@ -0,0 +1,1553 @@+%!PS-Adobe-2.0 EPSF-2.0+%%Title: /local/hda5/olaf/HaskPrg/hat-trail-1.eps+%%Creator: XV Version 3.10a  Rev: 12/29/94  -  by John Bradley+%%BoundingBox: 95 88 516 703+%%Pages: 1+%%DocumentFonts:+%%EndComments+%%EndProlog++%%Page: 1 1++% remember original state+/origstate save def++% build a temporary dictionary+20 dict begin++% define space for color conversions+/grays 421 string def  % space for gray scale line+/npixls 0 def+/rgbindx 0 def++% lower left corner+95 88 translate++% size of image (on paper, in 1/72inch coords)+420.98400 615.02400 scale++% define 'colorimage' if it isn't defined+%   ('colortogray' and 'mergeprocs' come from xwd2ps+%     via xgrab)+/colorimage where   % do we know about 'colorimage'?+  { pop }           % yes: pop off the 'dict' returned+  {                 % no:  define one+    /colortogray {  % define an RGB->I function+      /rgbdata exch store    % call input 'rgbdata'+      rgbdata length 3 idiv+      /npixls exch store+      /rgbindx 0 store+      0 1 npixls 1 sub {+        grays exch+        rgbdata rgbindx       get 20 mul    % Red+        rgbdata rgbindx 1 add get 32 mul    % Green+        rgbdata rgbindx 2 add get 12 mul    % Blue+        add add 64 idiv      % I = .5G + .31R + .18B+        put+        /rgbindx rgbindx 3 add store+      } for+      grays 0 npixls getinterval+    } bind def++    % Utility procedure for colorimage operator.+    % This procedure takes two procedures off the+    % stack and merges them into a single procedure.++    /mergeprocs { % def+      dup length+      3 -1 roll+      dup+      length+      dup+      5 1 roll+      3 -1 roll+      add+      array cvx+      dup+      3 -1 roll+      0 exch+      putinterval+      dup+      4 2 roll+      putinterval+    } bind def++    /colorimage { % def+      pop pop     % remove 'false 3' operands+      {colortogray} mergeprocs+      image+    } bind def+  } ifelse          % end of 'false' case++++% define the colormap+/cmap 48 string def+++% load up the colormap+currentfile cmap readhexstring+000000 000078 0000f8 00fc00 303030 686868 787c78 989898 a8a4a8 c0c0c0 +c8ccc8 d8d8d8 e0e4e0 f80000 f8fc00 f8fcf8 +pop pop   % lose return values from readhexstring+++% rlecmapimage expects to have 'w h bits matrix' on stack+/rlecmapimage {+  /buffer 1 string def+  /rgbval 3 string def+  /block  384 string def++  % proc to read a block from file, and return RGB data+  { currentfile buffer readhexstring pop+    /bcount exch 0 get store+    bcount 128 ge+    {  % it's a non-run block+      0 1 bcount 128 sub+      { currentfile buffer readhexstring pop pop++        % look up value in color map+        /rgbval cmap buffer 0 get 3 mul 3 getinterval store++        % and put it in position i*3 in block+        block exch 3 mul rgbval putinterval+      } for+      block  0  bcount 127 sub 3 mul  getinterval+    }++    { % else it's a run block+      currentfile buffer readhexstring pop pop++      % look up value in colormap+      /rgbval cmap buffer 0 get 3 mul 3 getinterval store++      0 1 bcount { block exch 3 mul rgbval putinterval } for++      block 0 bcount 1 add 3 mul getinterval+    } ifelse+  } % end of proc+  false 3 colorimage+} bind def+++421 615 8			% dimensions of data+[421 0 0 -615 0 615]		% mapping matrix+rlecmapimage++7f007f007f002400+81000f110f810a027f027f02540281010f350f810a00+82000f0a100a820602017f017f01530182000f0a340a810600+82000f0a820a06000a00020a820602017f017f01530183000f0a060d06020a0e06020a0e+06010a810600+82000f0a010a0c0f010a820602017f017f01530184000f0a060f0b0f820a0f0a820a060f+0b0f820a0f0a820a060f0b0f840a0f0a0600+82000f0a820a06000a00020a820602010301810f010401810f011301810f010601030f07+01810f010301080f0d01810f0182010f010401050f7f01700185000f0a060f0a0a0a8206+0f0a830a060f0a0a0a82060f0a830a060f0a0a0a84060f0a0600+82000f0a010a0c0f010a820602010301810f010401810f010801810f010601020f060181+0f010201810f010401010f0801810f011001810f0182010f010401810f010201010f7f01+6f0185000f0a060f0a0a0a82060f0a830a060f0a0a0a82060f0a830a060f0a0a0a84060f+0a0600+82000f0a820a06000a00020a820602010301810f010401810f010801810f010801810f01+0501810f010201810f010301830f010f010701810f011301810f010401810f010301810f+017f016e0185000f0a060f0a0a0a82060f0a830a060f0a810a000600010a82060f0a860a+060f0a06000a030a8200060a850a060f0a0600+82000f0a010a0c0f010a820602010301810f010401810f010101030f0101020f0801810f+010501810f010201810f010201810f0182010f010701810f010301820f010f810f018101+0f020f0201810f0182010f010401810f010301810f0183010f010f810f0181010f020f01+01810f010101810f010101810f010101020f0301030f0201820f010f810f017f01420185+000f0a060f0a0a0a82060f0a830a060f0a810a000600010a82060f0a830a060f0a810a00+81000a010a0100020a84060f0a0600+82000f0a820a06000a00020a820602010301810f010401810f0181010f810f0181010f81+0f0182010f010801810f010501810f010201810f010101810f010101810f010701810f01+0301010f0201010f0101010f0101810f0182010f010401810f010201810f010101010f02+01010f0101010f82010f010101810f010101810f0182010f010101810f0181010f810f01+81010f810f0181010f810f017f01440185000f0a060f0a0a0a82060f0a830a060f0a810a+000600010a82060f0a830a060f0a010a0100810a0081000a020a84060f0a0600+82000f0a010a0c0f010a820602010301070f0601810f0182010f010801810f010501810f+010201810f0182010f010201810f010701810f010301810f010701810f0182010f018201+0f010401040f0301810f010201810f010201830f010f010101810f010101810f0181010f+810f010301810f010201810f0182010f017f01450185000f0a060f0a0a0a82060f0a830a+060f0a820a000a040a81000a830a060f0a830a060f0a020a0200040a84060f0a0600+82000f0a820a06000a00020a820602010301810f010401810f010101040f0101810f0108+01810f010501810f010201810f0182010f010201810f010701810f010301810f01030104+0f0101810f0182010f010401810f010201810f010101810f010201810f010201810f0182+010f0182010f0182010f010201020f0201050f0101810f017f01450185000f0a060f0a0a+0a82060f0a830a060f0a820a000a040a81000a830a060f0a830a060f0a020a0200040a84+060f0a0600+82000f0a010a0c0f010a820602010301810f010401810f0181010f810f010101810f0182+010f010801810f010501810f010201810f0181010f050f0701810f010301810f01020101+0f0201810f0182010f0182010f010401810f010301810f0182010f010201810f01020181+0f0182010f0182010f0182010f010401010f0101810f010501810f017f01450185000f0a+060f0a0a0a82060f0a830a060f0a820a000a040a81000a830a060f0a830a060f0a010a01+00810a0081000a020a84060f0a0600+82000f0a820a06000a00020a820602010301810f010401810f0182010f010201810f0182+010f010801810f010501810f010201810f010501810f010701810f010301810f01020181+0f010201810f0182010f0182010f010401810f010301810f0182010f010201810f010201+810f0188010f010f010f010f010501810f0182010f010501810f017f01450185000f0a06+0f0a810a000600010a82060f0a830a060f0a820a000a040a81000a830a060f0a830a060f+0a810a0081000a010a0100020a84060f0a0600+82000f0a010a0c0f010a820602010301810f010401810f0181010f810f0181010f810f01+82010f010801810f010201810f0182010f010201810f010501810f010701810f01030181+0f010201010f0101010f0101810f0182010f010401810f010201010f0101810f01020101+0f0101010f0201810f010101810f010201810f010101810f0181010f810f0181010f810f+0182010f017f01450185000f0a060f0a810a000600010a82060f0a830a060f0a810a0006+00010a82060f0a860a060f0a06000a030a8200060a850a060f0a0600+82000f0a820a06000a00020a820602010301810f010401810f010101020f81010f810f01+81010f810f010601810f010201810f010101030f0701810f010701810f010301810f0103+01020f81010f830f010f0182010f010401050f0201810f010301030f0301810f01010181+0f010301020f0301030f0201810f017f01450185000f0a060f0a0a0a82060f0a830a060f+0a0a0a82060f0a830a060f0a0a0a84060f0a0600+82000f0a010a0c0f010a820602017f017f01530185000f0a060f0a0a0a82060f0a830a06+0f0a0a0a82060f0a830a060f0a0a0a84060f0a0600+82000f0a820a06000a00020a820602017f017f01530185000f0a060a060b06810f0a830a+060a060b06810f0a830a060a060b06830f0a0600+82000f0a010a0c0f010a820602017f017f01530182000f0a810a0f0d0f020a0e0f020a0e+0f820a0600+82000f0a100a820602017f017f01530182000f0a340a810600+82000f0a010a0f068101007f007f005400810a063106020a810600+82000f0a010a7f007f007f001a00020a810600+82000f0a010a81000c7f0c7f0c7f0c170c81000a010a810600+82000f0a010a82000c097f097f097f0915098205000a010a810600+82000f0a010a82000c097f097f097f0915098205000a010a810600+82000f0a010a82000c097f097f097f0915098205000a010a810600+82000f0a010a82000c097f097f097f0915098205000a010a810600+82000f0a010a82000c097f097f097f0915098205000a010a810600+82000f0a010a82000c097f097f097f0915098205000a010a810600+82000f0a010a82000c097f097f097f0915098205000a010a810600+82000f0a010a82000c097f097f097f0915098205000a010a810600+82000f0a010a82000c090a09080001090100010901001d090400160901007f097f090d09+0100060901000c09010015098205000a010a810600+82000f0a010a82000c090a09080001090100010901001b0908000f090100020901007f09+7f090d090100060901000c09010015098205000a010a810600+82000f0a010a82000c090a0901000c0901001a090200040902000e0901007f097f091209+0100060901000c09010015098205000a010a810600+82000f0a010a82000c090a0901000c0901001a090100060901000e0901007f097f091209+0100060901000c09010015098205000a010a810600+82000f0a010a82000c090a09010008090100010901000309030011090200060902000109+010081090002000209050081090081000902090400030901008109000200040903007f09+700901000609010004090300030901000109010081090002000c098205000a010a810600++82000f0a010a82000c090a09010008090100010901000209050010090100080901000109+0700010905008109008100090109060002090700020905007f096f090100060901000309+050002090100010907000b098205000a010a810600+82000f0a010a82000c090a090700020901000109010001090100030901000f0901000809+010001090200020901000309010002090100020901000209010002090200020901000109+0100020901007f096f090a0002090100030901000109010001090200020901000b098205+000a010a810600+82000f0a010a82000c090a090700020901000109010001090100030901000f0901000809+010001090100040901000209010002090100010901000409010001090100030901000109+01007f0974090a0002090100030901000109010001090100040901000a098205000a010a+810600+82000f0a010a82000c090a0901000809010001090100010907000f090100080901000109+010004090100020901000209010001090100040901000109010003090100010905007f09+7009010006090100020907000109010001090100040901000a098205000a010a810600+82000f0a010a82000c090a09010008090100010901000109010015090200060902000109+010004090100020901000209010001090100040901000109010003090100030904007f09+6f09010006090100020901000709010001090100040901000a098205000a010a810600+82000f0a010a82000c090a09010008090100010901000109010016090100060901000209+010004090100020901000209010001090100040901000109010003090100060901007f09+6f09010006090100020901000709010001090100040901000a098205000a010a810600+82000f0a010a82000c090a09010008090100010901000109020002090100100902000409+020002090200020901000309010002090100020901000209010002090100030901000109+0100020901007f096f090100060901000209020002090100010901000109020002090100+0b098205000a010a810600+82000f0a010a82000c090a09010008090100010901000209060011090800030907000309+0300810900810009010906000209010003090100010905007f0970090100060901000309+060001090100010907000b098205000a010a810600+82000f0a010a82000c090a09010008090100010901000309030015090400050901008109+00020005090200810900810009020904000309010003090100020903007f097109010006+09010004090300030901000109010081090002000c098205000a010a810600+82000f0a010a82000c09440901007f097f093a09010011098205000a010a810600+82000f0a010a82000c09440901007f097f093a09010011098205000a010a810600+82000f0a010a82000c09440901007f097f093a09010011098205000a010a810600+82000f0a010a82000c09440901007f097f093a09010011098205000a010a810600+82000f0a010a82000c097f097f097f0915098205000a010a810600+82000f0a010a82000c097f097f097f0915098205000a010a810600+82000f0a010a82000c097f097f097f0915098205000a010a810600+82000f0a010a82000c097f097f097f0915098205000a010a810600+82000f0a010a82000c097f097f097f0915098205000a010a810600+82000f0a010a82000c097f097f097f0915098205000a010a810600+82000f0a010a82000c057f057f057f05160581000a010a810600+82000f0a010a8100097f097f097f09170981000a010a810600+82000f0a010a8100097f097f097f09170981000a010a810600+82000f0a010a8100097f097f097f09170981000a010a810600+82000f0a010a8100097f097f097f09170981000a010a810600+82000f0a010a8100097f097f097f09170981000a010a810600+82000f0a010a8100097f097f097f09170981000a010a810600+82000f0a010a8100097f097f097f09170981000a010a810600+82000f0a010a8100097f097f097f09170981000a010a810600+82000f0a010a8100097f097f097f09170981000a010a810600+82000f0a010a8100097f097f097f09170981000a010a810600+82000f0a010a81000908097f0c7f0c7f0c010c0c0981000a010a810600+82000f0a010a81000908097f0c7f0c7f0c830c0904090a0981000a010a810600+82000f0a010a8100090709010c7f097f097f0901040b0981000a010a810600+82000f0a010a8100090709010c7f097f097f098304090409090981000a010a810600+82000f0a010a8100090609010c7f097f097f09010901040a0981000a010a810600+82000f0a010a8100090609010c7f097f097f0901098304090409080981000a010a810600++82000f0a010a8100090509010c7f097f097f0903090104090981000a010a810600+82000f0a010a8100090509010c7f097f097f0903098304090409070981000a010a810600++82000f0a010a8100090509010c7f097f097f0904090104080981000a010a810600+82000f0a010a8100090409010c7f090c090a04250903047f0943090104080981000a010a+810600+82000f0a010a8100090409010c7f090c0901040109020401090104260902047f09440901+04070981000a010a810600+82000f0a010a8100090309010c7f090d09810409010902040209810409250902047f0944+090104070981000a010a810600+82000f0a010a8100090309010c7f09110902042a0902047f0945090104060981000a010a+810600+82000f0a010a8100090309010c7f09110902040409020481090401040109040404090404+020903040609020481090481040901090204810904010402090304010903048109040204+01090704020903040109020481090401047f090c090104060981000a010a810600+82000f0a010a8100090209010c7f09120902040509020481090482040904810409810904+010402090204810904810409810904010481090481040904090604020902048109048104+098109048104098109048104098109040104810904010402090304010901040109020481+090481040981090401048109048104097f090b098304090409040981000a010a810600+82000f0a010a8100090209010c7f09120902040509020403090104010902040109020401+090104810904010401090104050902040109020401090204030902040109020481090401+04010902040109820409040104010982040904010401090104010902047f091009010405+0981000a010a810600+82000f0a010a8100090109010c7f09130902040509020406090304010902040409060405+090204010902040109020403090204010902040109020481090401048109048204090402+0402090604010902047f0910098304090409030981000a010a810600+82000f0a010a8100090109010c7f09130902040509020404090104810904010401090204+040902040909020401090204010902040309020401090204010902040109010482090409+0109030401090204050902047f0911090104040981000a010a810600+82000f0a010a81000981090c810c097f0913090204050902040309010401090204010902+040409020409090204010902040109020403090204010902040209020481090402040309+03048109040104050902047f0911090104040981000a010a810600+82000f0a010a81000981090c810c097f0913090204050902040309010401090204010902+040409020409090204010902040109020403090204010902040209070401098104098109+0401048109040104050902047f0912090104030981000a010a810600+82000f0a010a81000981090c810c097f0913090204050902040309060402090204810904+810409810904010481090481040904090204010901040209020404090104010901040409+01040109010402090104010901040109020481090481040981090401047f091209010403+0981000a010a810600+82000f0a010a8200090c810c097f09130904040309040403090204810904010402090304+030903040609010481090401040209040404090304050901040109010402090404030903+04010904047f0912090104020981000a010a810600+82000f0a010a8200090c810c097f097f097f090f090104020981000a010a810600+82000f0a010a81000c810c097f097f097f09110981040c010c81000a010a810600+82000f0a010a81000c810c097f097f097f09110981040c010c81000a010a810600+82000f0a010a81000c810c097f097f097f091309010481000a010a810600+82000f0a010a81000c810c097f097f097f091309010481000a010a810600+82000f0a010a81000c810c097f097f097f091309010481000a010a810600+82000f0a010a81000c810c097f097f097f091309010481000a010a810600+82000f0a010a81000c810c097f097f097f091309010481000a010a810600+82000f0a010a81000c810c0901097f077f077f070e070209010481000a010a810600+82000f0a010a81000c810c0901097f077f077e07820a070b040b810a0b040b810a090109+010481000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b030b830a0f070b030b+810a090109010481000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b030b020f040b810a09+0109010481000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b020b810a0f010f8107+0b020b810a090109010481000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b020b040f030b810a09+0109010481000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b010b810a0f030f8107+0b010b810a090109010481000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b010b060f020b810a09+0109010481000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b820b0a0f050f81070b+820b0a090109010481000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b810b0f070f010b810a+090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a83070b0a0f070f+83070b0a090109010481000a010a810600+82000f0a010a81000c810c0901090107070f0400090f01001a0f0100060f0302050f0302+7f0f7f0f300f010a82070b0f090f820b0a090109010481000a010a810600+82000f0a010a81000c810c0901090107060f0600080f0100140f0100030f0100060f0302+050f03027f0f7f0f300f010a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107060f0600080f0100140f0100040f81000f050f01+02090f01027f0f7f0f300f010a82070a070a07810a090109010481000a010a810600+82000f0a010a81000c810c0901090107050f0700080f0100020f0400030f0400020f0300+020f81000f060f0102090f01027f0f7f0f300f010a81070b0b0b810a090109010481000a+010a810600+82000f0a010a81000c810c0901090107060f0600080f0100010f0600010f0600010f0300+0b0f0102090f01027f0f7f0f300f010a81070a0c0a0209010481000a010a810600+82000f0a010a81000c810c0901090107060f0600080f0100010f0100020f0100010f0100+020f0100020f01000c0f0102090f01027f0f7f0f300f010a82070a0f090f82070a090109+010481000a010a810600+82000f0a010a81000c810c0901090107070f0400090f0100050f0200010f0300050f0100+0c0f0102090f01027f0f7f0f300f010a82070a0f090f82070a090109010481000a010a81+0600+82000f0a010a81000c810c0901090107090f81000f0a0f0100020f0500020f0400030f01+000c0f0102090f01027f0f7f0f300f010a82070a0f090f82070a090109010481000a010a+810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100010f0200010f0100050f02+00020f01000c0f0102090f01027f0f7f0f300f010a82070a0f090f82070a090109010481+000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100010f0100020f0100010f01+00020f0100020f01000c0f0102090f01027f0f7f0f300f010a82070a0f090f82070a0901+09010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100010f0600010f0600020f02+000b0f0102090f01027f0f7f0f300f010a82070a0f090f82070a090109010481000a010a+810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100020f0200810f000100010f+0400040f01000b0f0102090f01027f0f7f0f300f010a82070a0f090f82070a0901090104+81000a010a810600+82000f0a010a81000c810c0901090107090f81000f300f0102090f01027f0f7f0f300f01+0a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f300f0302050f03027f0f7f0f300f01+0a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f300f0302050f03027f0f7f0f300f01+0a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f01001a0f0100080f0102020f05+02160f0302120f0302050f0302010f01027f0f710f010a82070a0f090f82070a09010901+0481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100140f0100030f0100070f02+02020f0502150f0502110f0302050f0302010f02027f0f700f010a82070a0f090f82070a+090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100140f0100040f81000f060f+0102030f0102180f0202010f0202100f0102090f0102020f01027f0f700f010a82070a0f+090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100020f0400030f0400020f03+00020f81000f060f0102040f0102180f0102160f0102090f0102030f01027f0f6f0f010a+82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100010f0600010f0600010f03+000b0f0102030f04020b0f0102080f0102810f020102090f0102060f0102090f0102030f+01027f0f6f0f010a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100010f0100020f0100010f01+00020f0100020f01000c0f0102030f05020a0f0102080f0602080f0102060f0102090f01+02030f01027f0f6f0f010a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100050f0200010f0300050f01+000c0f0102030f81020f010f0202090f0102080f0202010f0202100f0102090f0102030f+01027f0f6f0f010a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100020f0500020f0400030f01+000c0f0102080f0102060f0702050f0102030f0102100f0102090f0102030f01027f0f6f+0f010a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100010f0200010f0100050f02+00020f01000c0f0102080f0102060f0702050f0102030f0102100f0102090f0102030f01+027f0f6f0f010a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100010f0100020f0100010f01+00020f0100020f01000c0f0102020f0202010f0202090f0102080f0202010f0202100f01+02090f0102030f01027f0f6f0f010a82070a0f090f82070a090109010481000a010a8106+00+82000f0a010a81000c810c0901090107090f81000f0a0f0100010f0600010f0600020f02+000b0f0102030f05020a0f0102090f0502080f0102060f0102090f0102030f01027f0f6f+0f010a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100020f0200810f000100010f+0400040f01000b0f0102040f03020b0f01020a0f0302090f0102060f0102090f0102030f+01027f0f6f0f010a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f310f0102370f0102090f0102020f01+027f0f700f010a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f310f0202360f0302050f0302010f02+027f0f700f010a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f320f0102360f0302050f0302010f01+027f0f710f010a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f01001a0f0100080f0102070f01+02010f0102100f0502070f0302130f0502160f0302120f0302050f0302010f01027f0f2f+0f010a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100140f0100030f0100070f02+02070f0102010f0102100f0502060f0502120f0502150f0502110f0302050f0302010f02+027f0f2e0f010a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100140f0100040f81000f060f+0102080f0102140f0102090f0202010f0202110f0102180f0202010f0202100f0102090f+0102020f01027f0f2e0f010a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100020f0400030f0400020f03+00020f81000f060f0102050f0502010f0102810f0281020f020f0102070f0102090f0102+030f0102110f0102180f0102160f0102090f0102030f01027f0f2d0f010a82070a0f090f+82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100010f0600010f0600010f03+000b0f0102040f0602010f0102810f0281020f020f0102060f0402070f0102030f010207+0f0102060f04020b0f0102080f0102810f020102090f0102060f0102090f0102030f0102+7f0f2d0f010a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100010f0100020f0100010f01+00020f0100020f01000c0f0102030f0202010f0202010f0102010f0102010f0102070f05+02060f0102030f0102070f0102060f05020a0f0102080f0602080f0102060f0102090f01+02030f01027f0f2d0f010a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100050f0200010f0300050f01+000c0f0102030f0102030f0102010f0102010f0102010f0102070f81020f010f0202050f+0102030f0102100f81020f010f0202090f0102080f0202010f0202100f0102090f010203+0f01027f0f2d0f010a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100020f0500020f0400030f01+000c0f0102030f0102030f0102010f0102010f0102010f01020c0f0102050f0102030f01+02150f0102060f0702050f0102030f0102100f0102090f0102030f01027f0f2d0f010a82+070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100010f0200010f0100050f02+00020f01000c0f0102030f0102030f0102010f0102020f03020d0f0102050f0102030f01+02150f0102060f0702050f0102030f0102100f0102090f0102030f01027f0f2d0f010a82+070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100010f0100020f0100010f01+00020f0100020f01000c0f0102030f0202010f0202010f0102020f0302070f0202010f02+02050f0202010f02020f0f0202010f0202090f0102080f0202010f0202100f0102090f01+02030f01027f0f2d0f010a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100010f0600010f0600020f02+000b0f0102040f0602010f0102030f0102090f0502070f0502080f0102060f05020a0f01+02090f0502080f0102060f0102090f0102030f01027f0f2d0f010a82070a0f090f82070a+090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100020f0200810f000100010f+0400040f01000b0f0102050f0202810f0281020f810f0281020f020f01020a0f0302090f+0302090f0102070f03020b0f01020a0f0302090f0102060f0102090f0102030f01027f0f+2d0f010a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f310f0102790f0102090f0102020f01+027f0f2e0f010a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f310f0202780f0302050f0302010f02+027f0f2e0f010a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f320f0102780f0302050f0302010f01+027f0f2f0f010a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a82070a0f090f82+070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f2d0f7f0d300d7f0f100f010a82070a+0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f2c0f7f0d320d7f0f0f0f010a82070a+0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f2c0f010d7f0f2e0f010d7f0f0f0f01+0a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f2c0f010d7f0f2e0f010d7f0f0f0f01+0a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f01001a0f0100020f010d030f01+02020f0300180f0102010f0102100f0502070f0302130f0502160f0302120f0302050f03+02010f0102050f010d7f0f0f0f010a82070a0f090f82070a090109010481000a010a8106+00+82000f0a010a81000c810c0901090107090f81000f0a0f0100140f0100030f0100020f01+0d020f0202010f0500170f0102010f0102100f0502060f0502120f0502150f0502110f03+02050f0302010f0202040f010d7f0f0f0f010a82070a0f090f82070a090109010481000a+010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100140f0100040f81000f010f+010d020f0102010f0200010f0200160f0102140f0102090f0202010f0202110f0102180f+0202010f0202100f0102090f0102020f0102040f010d7f0f0f0f010a82070a0f090f8207+0a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100020f0400030f0400020f03+00020f81000f020f010d010f0102020f0100030f0100120f0502010f0102810f0281020f+020f0102070f0102090f0102030f0102110f0102180f0102160f0102090f0102030f0102+030f010d7f0f0f0f010a82070a0f090f82070a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100010f0600010f0600010f03+00070f010d010f0102030f0100010f0100080f0102070f0602010f0102810f0281020f02+0f0102060f0402070f0102030f0102070f0102060f04020b0f0102080f0102810f020102+090f0102060f0102090f0102030f0102030f010d7f0f0f0f010a82070a0f090f82070a09+0109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100010f0100020f0100010f01+00020f0100020f0100080f010d010f0102040f0300090f0102060f0202010f0202010f01+02010f0102010f0102070f0502060f0102030f0102070f0102060f05020a0f0102080f06+02080f0102060f0102090f0102030f0102030f010d7f0f0f0f010a82070a0f090f82070a+090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100050f0200010f0300050f01+00080f010d010f0102030f0500110f0102030f0102010f0102010f0102010f0102070f81+020f010f0202050f0102030f0102100f81020f010f0202090f0102080f0202010f020210+0f0102090f0102030f0102030f010d7f0f0f0f010a82070a0f090f82070a090109010481+000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100020f0500020f0400030f01+00080f010d010f0102020f0200010f0200100f0102030f0102010f0102010f0102010f01+020c0f0102050f0102030f0102150f0102060f0702050f0102030f0102100f0102090f01+02030f0102030f010d7f0f0f0f010a82070a0f090f82070a090109010481000a010a8106+00+82000f0a010a81000c810c0901090107090f81000f0a0f0100010f0200010f0100050f02+00020f0100080f010d010f0102020f0100030f0100100f0102030f0102010f0102020f03+020d0f0102050f0102030f0102150f0102060f0702050f0102030f0102100f0102090f01+02030f0102030f010d7f0f0f0f010a82070a070a07810a090109010481000a010a810600++82000f0a010a81000c810c0901090107090f81000f0a0f0100010f0100020f0100010f01+00020f0100020f0100080f010d010f0102020f0200010f0200100f0202010f0202010f01+02020f0302070f0202010f0202050f0202010f02020f0f0202010f0202090f0102080f02+02010f0202100f0102090f0102030f0102030f010d7f0f0f0f010a81070b0b0b810a0901+09010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100010f0600010f0600020f02+00070f010d010f0102030f0500080f0102070f0602010f0102030f0102090f0502070f05+02080f0102060f05020a0f0102090f0502080f0102060f0102090f0102030f0102030f01+0d7f0f0f0f010a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100020f0200810f000100010f+0400040f0100070f010d010f0102040f0300090f0102080f0202810f0281020f810f0281+020f020f01020a0f0302090f0302090f0102070f03020b0f01020a0f0302090f0102060f+0102090f0102030f0102030f010d7f0f0f0f010a81070b0b0b810a090109010481000a01+0a810600+82000f0a010a81000c810c0901090107090f81000f2c0f010d020f01027f0f110f010209+0f0102020f0102040f010d7f0f0f0f010a81070b0b0b810a090109010481000a010a8106+00+82000f0a010a81000c810c0901090107090f81000f2c0f010d020f02027f0f100f030205+0f0302010f0202040f010d7f0f0f0f010a81070b0b0b810a090109010481000a010a8106+00+82000f0a010a81000c810c0901090107090f81000f2c0f010d030f01027f0f100f030205+0f0302010f0102050f010d7f0f0f0f010a81070b0b0b810a090109010481000a010a8106+00+82000f0a010a81000c810c0901090107090f81000f2c0f010d7f0f2e0f010d7f0f0f0f01+0a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f2c0f7f0d320d7f0f0f0f010a81070b+0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f2d0f7f0d300d7f0f100f010a81070b+0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f350f09037f0f7f0f2f0f010a81070b+0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f350f09037f0f7f0f2f0f010a81070b+0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a81070b0b0b810a+090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a81070b0b0b810a+090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a81070b0b0b810a+090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a81070b0b0b810a+090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a81070b0b0b810a+090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a81070b0b0b810a+090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f7f0f7f0f5b0f010a8107+0b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0f0f04030c0f0202080f81020f080f+03027f0f7f0f320f010a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0e0f06030a0f0302060f85020f020f+020f050f05027f0f7f0f310f010a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0e0f0603090f0102810f0281020f06+0f0202060f0202010f02027f0f7f0f300f010a81070b0b0b810a090109010481000a010a+810600+82000f0a010a81000c810c0901090107090f81000f0d0f0703090f0102810f0281020f06+0f0202060f0102030f01027f0f7f0f300f010a81070b0b0b810a090109010481000a010a+810600+82000f0a010a81000c810c0901090107090f81000f0e0f0603080f0102010f0102060f81+020f010f81020f040f0102030f01027f0f7f0f300f010a81070b0b0b810a090109010481+000a010a810600+82000f0a010a81000c810c0901090107090f81000f0e0f0603080f0102010f0102160f02+027f0f7f0f300f010a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0f0f0403080f0102020f0102150f02+027f0f7f0f310f010a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f090f0702130f02027f0f+7f0f320f010a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f090f0702120f02027f0f+7f0f330f010a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f0e0f0102120f02027f0f+7f0f340f010a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f0e0f0102110f07027f0f+7f0f300f010a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f0e0f0102110f07027f0f+7f0f300f010a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f7f0f7f0f5b0f010a8107+0b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f7f0f7f0f5b0f010a8107+0b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f7f0f7f0f5b0f010a8107+0b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f7f0f7f0f5b0f010a8107+0b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f7f0f7f0f5b0f010a8107+0b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f7f0f7f0f5b0f010a8107+0b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f7f0f7f0f5b0f010a8107+0b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f7f0f7f0f5b0f010a8107+0b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f7f0f7f0f5b0f010a8107+0b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f7f0f7f0f5b0f010a8107+0b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f090f110e7f0f7f0f3f0f+010a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f090f110e7f0f7f0f3f0f+010a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f090f110e7f0f7f0f3f0f+010a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f090f110e7f0f7f0f3f0f+010a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f090f110e7f0f7f0f3f0f+010a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f090f110e7f0f7f0f3f0f+010a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f090f810e0081000e010e+0100020e0400010e7f0f7f0f3f0f010a81070b0b0b810a090109010481000a010a810600++82000f0a010a81000c810c0901090107090f81000f110f81030f090f810e0081000e010e+0100010e0600810e0f7f0f7f0f3e0f010a81070b0b0b810a090109010481000a010a8106+00+82000f0a010a81000c810c0901090107090f81000f110f81030f090f010e0100810e0081+000e010e0100020e0100810e0f7f0f7f0f3e0f010a81070b0b0b810a090109010481000a+010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f090f010e0400020e0300+030e7f0f7f0f3f0f010a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f090f020e0200040e0400+010e7f0f7f0f3f0f010a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f090f010e0400060e0200+810e0f7f0f7f0f3e0f010a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f090f010e0100810e0081+000e010e0100020e0100810e0f7f0f7f0f3e0f010a81070b0b0b810a090109010481000a+010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f090f810e0081000e010e+0100010e0600810e0f7f0f7f0f3e0f010a81070b0b0b810a090109010481000a010a8106+00+82000f0a010a81000c810c0901090107090f81000f110f81030f090f810e0081000e010e+0100020e0400010e7f0f7f0f3f0f010a81070b0b0b810a090109010481000a010a810600++82000f0a010a81000c810c0901090107090f81000f110f81030f090f110e7f0f7f0f3f0f+010a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f090f110e7f0f7f0f3f0f+010a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f110f81030f090f110e7f0f7f0f3f0f+010a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f090f0f03030f110e7f0f7f0f3f0f01+0a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0b0f0c037f0f7f0f560f010a81070b+0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0c0f0a037f0f7f0f570f010a81070b+0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0d0f07037f0f7f0f590f010a81070b+0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0f0f04037f0f7f0f5a0f010a81070b+0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f100f02037f0f7f0f5b0f010a81070b+0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a81070b0b0b810a+090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a81070b0b0b810a+090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a81070b0b0b810a+090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a81070b0b0b810a+090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f210f01007f0f7f0f4b0f010a81070b+0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f210f01007f0f7f0f4b0f010a81070b+0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a81070b0b0b810a+090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100810f000200810f00010003+0f0400020f0100010f0100810f0002007f0f7f0f420f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0b00010f0600010f0100010f07+007f0f7f0f410f010a81070b0b0b810a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0200010f0200010f0100010f01+00020f0100010f0100010f0200020f01007f0f7f0f410f010a81070b0b0b810a09010901+0481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100020f0100020f0100050f02+00010f0100010f0100030f01007f0f7f0f410f010a81070b0b0b810a090109010481000a+010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100020f0100020f0100020f05+00010f0100010f0100030f01007f0f7f0f410f010a81070b0b0b810a090109010481000a+010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100020f0100020f0100010f02+00010f0100010f0100010f0100030f01007f0f7f0f410f010a81070b0b0b810a09010901+0481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100020f0100020f0100010f01+00020f0100010f0100010f0100030f01007f0f7f0f410f010a81070b0b0b810a09010901+0481000a010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100020f0100020f0100010f06+00010f0100010f0100030f01007f0f7f0f410f010a81070b0b0b810a090109010481000a+010a810600+82000f0a010a81000c810c0901090107090f81000f0a0f0100020f0100020f0100020f02+00810f000100810f0081000f810f0081000f020f01007f0f7f0f410f010a81070b0b0b81+0a090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a81070b0b0b810a+090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a81070b0b0b810a+090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a81070b0b0b810a+090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a81070b0b0b810a+090109010481000a010a810600+82000f0a010a81000c810c0901090107090f81000f7f0f7f0f6f0f010a81070b0b0b810a+090109010481000a010a810600+82000f0a010a81000c810c0901090107010f10007f0f7f0f680f010a81070b0b0b810a09+0109010481000a010a810600+82000f0a010a81000c810c0901090107010f10007f0f7f0f680f010a81070b0b0b810a09+0109010481000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b0b0b810a0901090104+81000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070a0c0a0209010481000a+010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a82070a0f090f82070a090109+010481000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a82070b0f090f820b0a090109+010481000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a83070b0a0f070f83070b0a09+0109010481000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b810b0f070f010b810a+090109010481000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b820b0a0f050f81070b+820b0a090109010481000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b010b060f020b810a09+0109010481000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b010b810a0f030f8107+0b010b810a090109010481000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b020b040f030b810a09+0109010481000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b020b810a0f010f8107+0b020b810a090109010481000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b030b020f040b810a09+0109010481000a010a810600+82000f0a010a81000c810c09010901077f0f7f0f7b0f010a81070b030b830a0f070b030b+810a090109010481000a010a810600+82000f0a010a81000c810c09010901077f0a7f0a7d0a81070b040b81070b040b810a0901+09010481000a010a810600+82000f0a010a81000c810c09010981070a7f0a7f0a7d0a81070a0c0a0209010481000a01+0a810600+82000f0a010a81000c810c0901097f077f077f070e0f0209010481000a010a810600+82000f0a010a81000c810c09010981070b090b010a810b0a6e0a7f0b720b010a0a0b810a+0f0d0f0209010481000a010a810600+82000f0a010a81000c810c09010981070b070b810a0f840f070b0a0f6c0f81070b7f0b71+0b810a0f820f0a0b070b810a0f0d0f0209010481000a010a810600+82000f0a010a81000c810c09010981070b050b810a0f020f83070b0a0f6c0f81070b7f0b+710b810a0f020f810a0b050b810a0f0d0f0209010481000a010a810600+82000f0a010a81000c810c09010981070b030b810a0f040f83070b0a0f6c0f81070b7f0b+710b810a0f040f810a0b030b810a0f0d0f0209010481000a010a810600+82000f0a010a81000c810c09010981070b010b810a0f060f83070b0a0f6c0f81070b7f0b+710b810a0f060f810a0b010b810a0f0d0f0209010481000a010a810600+82000f0a010a81000c810c09010983070b0a0f080f83070b0a0f6c0f81070b7f0b710b81+0a0f080f830a0b0a0f0d0f0209010481000a010a810600+82000f0a010a81000c810c09010982070a0f090f83070b0a0f6c0f81070b7f0b710b810a+0f090f82070a0f0d0f0209010481000a010a810600+82000f0a010a81000c810c09010983070b070f080f83070b0a0f6c0f81070b7f0b710b81+0a0f080f83070b0a0f0d0f0209010481000a010a810600+82000f0a010a81000c810c09010981070b010b81070f060f83070b0a0f6c0f81070b7f0b+710b810a0f060f81070b010b810a0f0d0f0209010481000a010a810600+82000f0a010a81000c810c09010981070b030b81070f040f83070b0a0f6c0f81070b7f0b+710b810a0f040f81070b030b810a0f0d0f0209010481000a010a810600+82000f0a010a81000c810c09010981070b050b81070f020f83070b0a0f6c0f81070b7f0b+710b810a0f020f81070b050b810a0f0d0f0209010481000a010a810600+82000f0a010a81000c810c09010981070b070b81070f840f070b0a0f6c0f81070b7f0b71+0b810a0f820f070b070b810a0f0d0f0209010481000a010a810600+82000f0a010a81000c810c09010981070b090b0107820b0a076d077f0b720b820a070b09+0b810a0f0d0f0209010481000a010a810600+82000f0a010a81000c810c09010981070a7f0a7f0a7d0a0e0f0209010481000a010a8106+00+82000f0a010a81000c810c097f097f097f091309010481000a010a810600+82000f0a010a81000c810c097f097f097f091309010481000a010a810600+82000f0a010a81000c810c097f097f097f091309010481000a010a810600+82000f0a010a8100047f047f047f04170481000a010a810600+82000f0a010a8100047f047f047f04170481000a010a810600+82000f0a010a8100097f097f097f09170981000a010a810600+82000f0a010a820009057f057f057f0515058209000a010a810600+82000f0a010a820009057f057f057f051405830c09000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a820009058105097f097f097f091109010c8209000a010a810600+82000f0a010a8200090581050c7f0c7f0c7f0c130c8209000a010a810600+82000f0a010a830009050c7f0c7f0c7f0c140c8209000a010a810600+82000f0a010a8100097f097f097f09170981000a010a810600+82000f0a010a8100097f0954097f0c340c0d0981000a010a810600+82000f0a010a8100097f0954097f0c330c820904090b0981000a010a810600+82000f0a010a8100097f095309010c7f09320901040c0981000a010a810600+82000f0a010a8100097f095309010c7f09320983040904090a0981000a010a810600+82000f0a010a8100097f095209010c7f09340901040b0981000a010a810600+82000f0a010a81000908097f0c340c1409010c7f0934098304090409090981000a010a81+0600+82000f0a010a81000907097f0c340c820904091109010c7f09360901040a0981000a010a+810600+82000f0a010a8100090709010c7f09320983040904091009010c7f093609830409040908+0981000a010a810600+82000f0a010a8100090609010c7f09340901041109010c7f0937090104090981000a010a+810600+82000f0a010a8100090609010c7f09340983040904090e09010c31090304820904094509+030435090104090981000a010a810600+82000f0a010a8100090509010c200907047f090d0901040f09010c2f0901040209020447+09020436090104080981000a010a810600+82000f0a010a8100090509010c21090104020902047f090c0983040904090c09010c2f09+0204030901044709020436090104080981000a010a810600+82000f0a010a8100090409010c2209010403090104520981040916098104091f0901040d+09010c2f0902044d09020437090104070981000a010a810600+82000f0a010a8100090409010c22090104030901045109010416090104210901040c0901+0c2f09040406090304020903048109040204010902048109040104020904040209030408+09040402090304040901048109040104030903042f090104070981000a010a810600+82000f0a010a8100090309010c2309010403090104010901048109048104090109030404+090404020901048109048104090109030403090104010901040209010409090304020902+0401090204010904040109010481090401040109020401090204010904041f0901040b09+010c31090404040901040109010402090204010902040209020481090481040981090401+048109048104098109040104810904810409050902048109048104098109048104098109+0481040901090604020902048109048104092d098304090409050981000a010a810600+82000f0a010a8100090309010c2309010402090104010902048109048104098109048104+098109048104098109048104098109048104090109020481090481040981090481040982+090409010902048109040204810904020407090104010901040209010402090104020901+04020903048109040104010901040209010402090104220901040a09010c320905040109+020401090204010902040109020402090204030902040109010481090401040109010405+0902040109010481090401040109020481090401040109020401090204010901042f0901+04060981000a010a810600+82000f0a010a8100090209010c2409050403090204020901040309010481090481040901+098104090209020403090104010901040209020401090204010901040609010403090104+010901040209010402090104030901040209010401090104020901040209010422098304+0904090709010c3509040481090401040109020401090204010902040209020403090204+04090604050902040409020401090204810904010401090204010906042f098304090409+040981000a010a810600+82000f0a010a8100090209010c2409010407090104030901040309010481090481040901+098104090209010407090204020901040209010402090104060901040309010401090104+02090104020901040309010402090104010901040209010402090104230901040809010c+360903048109040104010902040109020401090204020902040309020404090204090902+0404090204010902048109040104010902040109020434090104050981000a010a810600++82000f0a010a8100090109010c2509010407090104030901040309010481090481040981+090481040902090104050901048109048104090109010402090104020901040609010403+090104010901040209010402090104030901040209010401090104020901040209010423+0983040904090509010c3809020481090401040109020401090204010902040209020403+090204040902040909020404090204010902048109040104010902040109020434090104+050981000a010a810600+82000f0a010a8100090109010c2509010407090104030901040309010401090304040901+040409010401090104020901040209010402090104060901040309010401090104020901+04020901040309010402090104010901040209010402090104240901040609010c320901+040309020481090401040109020401090204010902040209020403090204040902040909+020404090204010902048109040104010902040109020435090104040981000a010a8106+00+82000f0a010a81000981090c810c09250901040709010403090104030901040109810409+060901040409010401090104020901040209010402090104060901040309010401090104+02090104020901040309010402090104010901040209010402090104250901040509010c+320902040109020402090104010901040209070402090204040902048109048104098109+040104810904810409050902048109048104098109048104098109048104090109020481+090401040209020481090481040930090104040981000a010a810600+82000f0a010a81000981090c810c09250901040709010404090104010901040209040403+090104040905040209010402090104020901040709010401090104020902048109040104+020902048309040904010481090481040901090204810904010402090204820904092109+01040409010c330982040904020405090304040903048109040104810904030404090304+0309030408090304030903040409020481090401040209030433090104030981000a010a+810600+82000f0a010a8200090c810c092509030405090304040903040309060481090402040409+010401090104810904020481090402048109040204070903040409020481090401040209+02040109040404090204810904010402090204240901040309010c7f0943090104030981+000a010a810600+82000f0a010a81000c420c81040c030c01043e0c0104400c7f09450981040c010c820900+0a010a810600+82000f0a010a81000c420c0104040c81040c3d0c0104400c7f09450981040c010c820900+0a010a810600+82000f0a010a81000c810c097f097f097f091309010481000a010a810600+82000f0a010a81000c810c097f097f097f091309010481000a010a810600+82000f0a010a81000c810c097f097f097f091309010481000a010a810600+82000f0a010a81000c810c097f097f097f091309010481000a010a810600+82000f0a010a81000c810c097f097f097f091309010481000a010a810600+82000f0a010a81000c810c097f097f097f0903090c050209010481000a010a810600+82000f0a010a81000c810c0902097f057f057b0504098105080308810c080308810c0901+09010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c0903098105080208830c09+05080208810c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c0903098105080208020903+08810c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c0903098105080108810c09+01098105080108810c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c0903098105080108040902+08810c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030981050882080c0903+0981050882080c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c0903098105088108090509+0108810c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c0903098305080c09050983+05080c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c0903098205080907098208+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c050805810c+090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c0903098105080908810c09+0109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030981050c0a0c020901+0481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c090209810509160981000928090200570902001f0902007f09+3509810c09030982050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c09020981050916098100092a098100090d0981000946098100+09050904000c0981000908098100097f093409810c09030982050c09070982050c090109+010481000a010a810600+82000f0a010a81000c810c09020981050943098100090d09810009460981000907098100+090d0981000908098100097f093409810c09030982050c09070982050c09010901048100+0a010a810600+82000f0a010a81000c810c09020981050981090082000900820009008100090109030004+090200030901008109000100210981000905090200020905000b09020081090001000309+04000d090100060901000f09810009070981000902090100810900010002090500060981+00097f093409810c09030982050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c09020981050901090100810900830009000982090009020981+000904098100090309010002098100090a0906000d098100090409810009010981000902+098100090e098100090109810009020981000902098100090c090100060901000f098100+090709810009030901000209810009020981000908098100097f093409810c0903098205+0c09070982050c090109010481000a010a810600+82000f0a010a81000c810c09020981050901098100098209000982090009050981000904+09810009030981000902098100091f098100090309810009030981000901098100090f09+830009000903098100092c09810009070981000903098100090209810009020981000908+098100097f093409810c09030982050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c09020981050901098100098209000982090009010904000509+810009030981000902098100090a0906000d098100090309060002098100091009810009+050903002909810009070981000903098100090209810009020981000908098100097f09+3409810c09030982050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c09020981050901098100098209000982090009820900090209+8100090409810009030981000902098100091f09810009030981000907098100090f0983+000900090809810009270981000907098100090309810009020981000902098100090809+8100097f093409810c09030982050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c09020981050901098100098209000982090009820900090209+8100090409810009030981000902098100091f0981000904098100090209810009010981+000901098100090a098100090109810009020981000902098100090c090100060901000f+098100090709810009030981000902098100090209810009010981000904098100097f09+3409810c09030982050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c09020981050981090001008109008200090081000981090002+00820900090109040001090200010902001d09040004090300040902000b090200810900+0100020904000e090100060901000f098100090509040001090200010902000309020006+098100097f093409810c09030982050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f091c0981000922098100097f093409810c09+030982050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f091c0902001f0902007f093509810c090309+82050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f09100908007f095e09810c09030982050c09+070982050c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f09100908007f095e09810c09030982050c09+070982050c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f091009020002090200030901000d0902000e+0904000c0901000909010005098100090d090100100901000e0904000d09020004090200+4009810c09030982050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f091009020081090003000209830009000904+09810009040981000901098100090c098100090f0901000a0981000904098100090d0901+000f09810009820900090c098100090f0981000908098100093f09810c09030982050c09+070982050c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f091009020081090003000209830009000904+09810009040981000901098100090c09810009100901000909810009150901000d098100+0902098100090b098100090809810009030981000909098100093f09810c09030982050c+09070982050c090109010481000a010a810600+82000f0a010a81000c810c090209810509630902008109000100030904001c0902008109+0003000109810009820900090209040007098100090c0981000911098100090409020082+09000902090200030902000109020004098100090c0981000902098100090b0981000908+09810009030981000909098100093f09810c09030982050c09070982050c090109010481+000a010a810600+82000f0a010a81000c810c09020981050964098100090109810009020981000902098100+090a090600090902008109000300010981000982090009040981000907098100090d0903+00150981000901090100050981000903098100090209810009130981000902098100090b+0903000609810009030982000900010006098100093f09810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c09020981050965098300090009030981000920090200810900+030082090009010981000903098300090009050981000912098100091209810009030981+0009040981000903098100090209810009130981000902098100090f0981000901090600+01090100020981000904098100093f09810c09030982050c09070982050c090109010481+000a010a810600+82000f0a010a81000c810c0902098105096609810009050903000c090600090902008109+000300820900090109810009020981000901098100090309810009130981000912098100+0903098100090409810009040981000982090009140981000902098100090f0981000904+098100090309810009020981000904098100093f09810c09030982050c09070982050c09+0109010481000a010a810600+82000f0a010a81000c810c0902098105096509830009000908098100091b090200810900+030081090004000b09810009140981000912098100090309810009040981000904098100+0982090009140981000902098100090f0981000904098100090309810009020981000904+098100093f09810c09030982050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c09020981050964098100090109810009020981000902098100+091b090200810900030004098100090b0981000901098100090409010004098100090209+810009130981000901090100050981000905090100170981000982090009040901000409+810009020981000904098100090409810009010981000904098100093f09810c09030982+050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c090209810509630902008109000100020904001d0902008109+000300030902000b09040005090100050903001609020081090081000901090400040901+001809010006090100050903000e09020006098100093f09810c09030982050c09070982+050c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f091009020081090003001c09010057090100+23098100093f09810c09030982050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f0910090200020902001c0981000957098100+09210902004009810c09030982050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f09100908007f095e09810c09030982050c09+070982050c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c09020981050943098100093309810009220981000901090100+1d090100270902002109010020098100094109810c09030982050c09070982050c090109+010481000a010a810600+82000f0a010a81000c810c090209810509430981000933098100090d0981000911098100+0903098100091d09810009280981000916098100090709010021098100094009810c0903+0982050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f090909810009110981000903098100091d09+810009280981000916098100090609010022098100094009810c09030982050c09070982+050c090109010481000a010a810600+82000f0a010a81000c810c09020981050941090200030901008109000100140901008109+000100030901000109010003090200030901008109000100020905000e09810009040982+000900010005090200040903000409020082090009090902008109000100030904000e09+81000904090300040904000109050004098100090d090200810900010003090400050981+00093f09810c09030982050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c09020981050943098100090309010002098100091309010002+098100090209830009000982090009030981000903090100020981000902098100091009+810009040901000209810009020981000901098100090109810009020981000901098100+09010901000b098100090109810009020981000902098100090d09810009030981000902+098100090109810009020981000902098100091709810009010981000902098100090209+81000904098100093f09810c09030982050c09070982050c090109010481000a010a8106+00+82000f0a010a81000c810c09020981050943098100090309810009020981000913098100+090309810009010901000809810009030981000902098100090209810009100981000904+0981000902098100090109810009030981000905098100098209000903098100090b0983+000900090309810009120981000908098100090109810009070981000918098300090009+030981000909098100093f09810c09030982050c09070982050c090109010481000a010a+810600+82000f0a010a81000c810c09020981050943098100090309810009020981000913098100+090309810009010981000908098100090309810009020981000902098100091009810009+040981000902098100090109060002090400010981000903098100090c09810009050903+000f098100090409040003090300040981000919098100090509030006098100093f0981+0c09030982050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c09020981050943098100090309810009020981000913098100+090309810009010981000908098100090309810009020981000902098100091009810009+040981000902098100090109810009060981000902098100098209000903098100090b09+830009000908098100090d09810009030981000902098100090609810009020981000918+098300090009080981000904098100093f09810c09030982050c09070982050c09010901+0481000a010a810600+82000f0a010a81000c810c09020981050943098100090309810009020981000913090100+02098100090209810009080981000903098100090209810009020981000901098100090c+098100090409810009020981000902098100090209810009820900090209810009010981+0009010901000b0981000901098100090209810009020981000903090100070981000903+098100090209810009010981000902098100090209810009010981000913098100090109+8100090209810009020981000904098100093f09810c09030982050c09070982050c0901+09010481000a010a810600+82000f0a010a81000c810c09020981050941090400010902000109020013098200090001+0003090400040904000109020001090200030902000f0981000902090200010902000309+030003090300820900090109020081090081000908090200810900010002090400050901+000509040003090300820900098109000300050902001409020081090001000209040005+098100094009810c09030982050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c09020981050964098100093609810009430901004f09810009+4009810c09030982050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c0902098105096409810009370981000942098100094e098100+094109810c09030982050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c090209810509630903007f097f091009810c09030982050c09+070982050c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c09020981050902090200210901001109810009270981000921+090200210901007f094709810c09030982050c09070982050c090109010481000a010a81+0600+82000f0a010a81000c810c09020981050904098100091609810009070901001009810009+290981000922098100091609810009070901007f094709810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c09020981050904098100091609810009060901001109810009+290981000922098100091609810009060901007f094809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c09020981050904098100090409030004090400010905000409+810009100981000903090200810900010004090100030902008109000100030904000509+810009210981000904090300040904000109050004098100090d09020081090001000309+04007f092a09810c09030982050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c09020981050904098100090309810009020981000901098100+090209810009020981000919098100090409810009010981000904090100040981000901+098100090209810009020981000904098100090c0906000d098100090309810009020981+000901098100090209810009020981000917098100090109810009020981000902098100+097f092909810c09030982050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c09020981050904098100090809810009010981000907098100+091909810009050983000900090d09830009000903098100090909810009210981000908+09810009010981000907098100091809830009000903098100097f092e09810c09030982+050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c09020981050904098100090409040003090300040981000919+0981000906098100090f098100090509030006098100090c0906000d0981000904090400+0309030004098100091909810009050903007f092b09810c09030982050c09070982050c+090109010481000a010a810600+82000f0a010a81000c810c09020981050904098100090309810009020981000906098100+0902098100091909810009050983000900090d0983000900090809810009040981000921+098100090309810009020981000906098100090209810009180983000900090809810009+7f092909810c09030982050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c09020981050904098100090309810009020981000901098100+090209810009020981000901098100091509810009040981000901098100090409010004+098100090109810009020981000902098100090409810009210981000903098100090209+810009010981000902098100090209810009010981000913098100090109810009020981+000902098100097f092909810c09030982050c09070982050c090109010481000a010a81+0600+82000f0a010a81000c810c09020981050902090400030903008209000981090003000509+020018098100090209020081090001000409010003090200810900010002090400050981+000920090400030903008209000981090003000509020014090200810900010002090400+7f092b09810c09030982050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c0902098105093a0981000929098100097f097f090f09810c09+030982050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c0902098105093b0981000927098100097f097f091009810c09+030982050c09070982050c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c050805810c+090109010481000a010a810600+82000f0a010a81000c810c09020981050902090200210901000f0902000d0902007f097f+092a09810c0903098105080908810c090109010481000a010a810600+82000f0a010a81000c810c09020981050904098100091609810009070901000f09810009+10098100097f097f092909810c0903098105080908810c090109010481000a010a810600++82000f0a010a81000c810c09020981050904098100091609810009060901001009810009+10098100097f097f092909810c0903098105080908810c090109010481000a010a810600++82000f0a010a81000c810c09020981050904098100090409030004090400010905000409+810009100981000903090200810900010005098100091d09020081090001007f097f0904+09810c0903098105080908810c090109010481000a010a810600+82000f0a010a81000c810c09020981050904098100090309810009020981000901098100+090209810009020981000919098100090409810009010981000905098100090c0906000a+0981000901098100097f097f090409810c0903098105080908810c090109010481000a01+0a810600+82000f0a010a81000c810c09020981050904098100090809810009010981000907098100+0919098100090509830009000906098100091f0983000900097f097f090509810c090309+8105080908810c090109010481000a010a810600+82000f0a010a81000c810c09020981050904098100090409040003090300040981000919+09810009060981000907098100090c0906000c098100097f097f090609810c0903098105+080908810c090109010481000a010a810600+82000f0a010a81000c810c09020981050904098100090309810009020981000906098100+09020981000919098100090509830009000906098100091f0983000900097f097f090509+810c0903098105080908810c090109010481000a010a810600+82000f0a010a81000c810c09020981050904098100090309810009020981000901098100+090209810009020981000901098100091509810009040981000901098100090509810009+1e0981000901098100097f097f090409810c0903098105080908810c090109010481000a+010a810600+82000f0a010a81000c810c09020981050902090400030903008209000981090003000509+0200170981000903090200810900010005098100091d09020081090001007f097f090409+810c0903098105080908810c090109010481000a010a810600+82000f0a010a81000c810c090209810509390981000910098100097f097f092909810c09+03098105080908810c090109010481000a010a810600+82000f0a010a81000c810c090209810509390902000d0902007f097f092a09810c090309+8105080908810c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c0903098105080908810c09+0109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030981050c0a0c020901+0481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030982050c0907098205+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c0903098205080907098208+0c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c0903098305080c09050983+05080c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c0903098105088108090509+0108810c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c09030981050882080c0903+0981050882080c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c0903098105080108040902+08810c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c0903098105080108810c09+01098105080108810c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c0903098105080208020903+08810c090109010481000a010a810600+82000f0a010a81000c810c0902098105097f097f097809810c0903098105080208830c09+05080208810c090109010481000a010a810600+82000f0a010a81000c810c09020981050c7f0c7f0c790c04098105080308810508030881+0c090109010481000a010a810600+82000f0a010a81000c810c097f097f097f09030981050c0a0c0209010481000a010a8106+00+82000f0a010a81000c810c097f097f097f091309010481000a010a810600+82000f0a010a81000c810c097f097f097f091309010481000a010a810600+82000f0a010a81000c810c097f097f097f091309010481000a010a810600+82000f0a010a81000c810c097f097f097f091309010481000a010a810600+82000f0a010a81000c810c0901097f057f057d051309010481000a010a810600+82000f0a010a81000c810c0901098105080708010c81080c7f0c7f0c620c81080c810c08+0708810c091209010481000a010a810600+82000f0a010a81000c810c0901098105080508810c09840905080c097f097f0960098305+080c0982090c080508810c091209010481000a010a810600+82000f0a010a81000c810c0901098105080308810c0902098305080c097f097f09600983+05080c090209810c080308810c091209010481000a010a810600+82000f0a010a81000c810c0901098105080108810c0904098305080c097f097f09600983+05080c090409810c080108810c091209010481000a010a810600+82000f0a010a81000c810c0901098305080c0906098305080c097f097f0960098305080c+090609830c080c091209010481000a010a810600+82000f0a010a81000c810c09010982050c0907098305080c097f097f0960098305080c09+070982050c091209010481000a010a810600+82000f0a010a81000c810c090109830508050906098305080c097f097f0960098305080c+0906098305080c091209010481000a010a810600+82000f0a010a81000c810c090109810508010881050904098305080c097f097f09600983+05080c0904098105080108810c091209010481000a010a810600+82000f0a010a81000c810c090109810508030881050902098305080c097f097f09600983+05080c0902098105080308810c091209010481000a010a810600+82000f0a010a81000c810c0901098105080508810509840905080c097f097f0960098305+080c09820905080508810c091209010481000a010a810600+82000f0a010a81000c810c0901098105080708010582080c057f057f05610583080c0508+0708810c091209010481000a010a810600+82000f0a010a81000c810c09010981050c7f0c7f0c7b0c1309010481000a010a810600+82000f0a010a81000c810c097f097f097f091309010481000a010a810600+82000f0a010a81000c810c097f097f097f091309010481000a010a810600+82000f0a010a81000c810c097f097f097f091309010481000a010a810600+82000f0a010a8100047f047f047f04170481000a010a810600+82000f0a010a8100047f047f047f04170481000a010a810600+82000f0a010a7f007f007f001a00020a810600+82000f0a7f0a7f0a7f0a1f0a810600+82000f0a7f0a7f0a7f0a1f0a810600+82000f0a7f0a7f0a7f0a1f0a810600+82000a067f067f067f0620060000+7f007f007f002400++%+% Compression made this file 5.08% of the uncompressed size.+%+++showpage++% stop using temporary dictionary+end++% restore original state+origstate restore++%%Trailer
+ docs/hat-trail-1.pdf view

binary file changed (absent → 777689 bytes)

+ docs/hat-trail.gif view

binary file changed (absent → 2466 bytes)

+ docs/hat-trans.html view
@@ -0,0 +1,137 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<html><head><title>hat-trans reference guide</title></head>+<body bgcolor=#ffffff>+<table><tr><td width=500>++<center><h1>hat-trans reference guide</h1></center>++<hr>++<p>+<b>hat-trans</b> is a stand-alone program that performs a+source-to-source transformation on a single Haskell module, such+that the functions in the transformed module deposit traces in a+<em>.hat</em> file in addition to computing their original results.+<p>+The transformed module is written to a file of the same name as the+original, but in a directory called <tt>Hat</tt>.  If the directory+does not exist, hat-trans creates it.  If the module is part of the+hierarchical namespace, then a single <tt>Hat</tt> directory is created+at the root of the tree, and it is populated with new directories+corresponding to the remainder of the hierarchy.  For instance, a+module called <tt>A.B.C</tt>, in a file named <tt>A/B/C.hs</tt>,+is transformed by hat-trans into a module called <tt>Hat.A.B.C</tt>,+stored in a file named <tt>Hat/A/B/C.hs</tt>.++</td></tr></table>++<table width=500>+<tr><td valign=top>+<p>+<b>File arguments.</b>++<table width=250><tr>+<td valign=top><em>.hs</em></td>+  <td>Haskell source file</td>+</tr><tr>+<td valign=top><em>.lhs</em></td>+  <td>literate Haskell source file</td>+</tr></table>++</td><td valign=top>+<p>+<b>Flags.</b>++<table width=250><tr>+<td valign=top><em><b>-I</b>dir</em></td>+  <td>search directory <em>dir</em> for imported modules during transformation.+      (hat-trans actually looks for the <em>.hx</em> file generated by a+      prior invocation of hat-trans, rather than the source module itself.)</td>+</tr><tr>+<td valign=top><em><b>-P</b>dir</em></td>+  <td>search directory <em>dir</em> for prelude and stdlib modules during+      transformation</td>+</tr><tr>+<td valign=top><em><b>+RTS</b></em></td>+  <td>the following options (up to <em><b>-RTS</b></em>) should be passed only+      to hat-trans's runtime system+      (for instance to increase its heap size for processing a large file)</td>+</tr></table>++</table>+++<table width=500>+<tr><td valign=top>+<p>+<b>Options to change the usual transformation behaviour.</b>++<table width=250><tr>+<td valign=top><em><b>-unix</b></em></td>+  <td>Use unix filenames (default)</td>+</tr><tr>+<td valign=top><em><b>-nounix</b></em></td>+  <td>Use RiscOS filenames</td>+</tr><tr>+<td valign=top><em><b>-unlit</b></em></td>+  <td>Unliterate the source code</td>+</tr><tr>+<td valign=top><em><b>-nounlit</b></em></td>+  <td>Do not unliterate the source code (default)</td>+</tr><tr>+<td valign=top><em><b>-underscore</b></em></td>+  <td>Treat underscores strictly as lowercase (default)</td>+</tr><tr>+<td valign=top><em><b>-nounderscore</b></em></td>+  <td>Treat underscores as invisible, e.g. _f is varid, _F is conid</td>+</tr><tr>+<td valign=top><em><b>-prelude</b></em></td>+  <td>Treat prelude definitions specially</td>+</tr><tr>+<td valign=top><em><b>-noprelude</b></em></td>+  <td>Do not treat definitions specially (default)</td>+</tr><tr>+<td valign=top><em><b>-trusted</b></em></td>+  <td>make this a "trusted" module</td>+</tr><tr>+<td valign=top><em><b>-notrusted</b></em></td>+  <td>make this an "untrusted" module (default)</td>+</tr></table>++</td><td valign=top>+<p>+<b>Options to examine the internal progress of the transformation.</b>++<table width=250><tr>+<td valign=top><em>-<b>showwidth=</b>w</em></td>+  <td>set width in characters of output of an intermediate syntax tree+      to <em>w</em> (default=80)</td>+</tr><tr>+<td valign=top><em>-<b>showindent=</b>i</em></td>+  <td>set indentation in characters for nesting of output of an intermediate+      syntax tree to <em>i</em> (default=2)</td>+</tr><tr>+<td valign=top><em>-<b>showqualified</b></em></td>+  <td>use qualified names in output of intermediate syntax tree+  (default=on)</td>+</tr><tr>+<td valign=top><em><b>-lex</b></em></td>+  <td>show lexical input</td>+</tr><tr>+<td valign=top><em><b>-parse</b></em></td>+  <td>show syntax tree after parser</td>+</tr><tr>+<td valign=top><em><b>-tracefns</b></em></td>+  <td>show syntax tree after tracing translation</td>+</tr></table>++</td></tr></table>++<table><tr><td width=500>++<hr>+<p>+This page last updated: 5th February 2003<br>+</td></tr></table>+</body></html>+
+ docs/hat.gif view

binary file changed (absent → 1082 bytes)

+ docs/hatexploreuser.pdf view

binary file changed (absent → 99214 bytes)

+ docs/hatexploreuser.tex view
@@ -0,0 +1,449 @@+% Created: 2005+% Last Update: 29 April 2005 (Olaf)++\documentclass[12pt]{article}++\usepackage[a4paper]{geometry}+\usepackage{pstricks}+\usepackage{pst-node}+\usepackage{xspace}+\usepackage{alltt}+++%------------------------------------------------------------------------------++\renewcommand{\textfraction}{0.01}+\renewcommand{\topfraction}{0.95}+\renewcommand{\bottomfraction}{0.95}++\newcommand{\Hat}{\textsc{Hat}\xspace}+\newcommand{\hatdetect}{\textsc{hat-detect\xspace}}+\newcommand{\hatobserve}{\textsc{hat-observe}\xspace}+\newcommand{\hattrail}{\textsc{hat-trail}\xspace}+\newcommand{\hatexplore}{\textsc{hat-explore}\xspace}++\newenvironment{shot}{\begin{figure}[!h]\vspace{-0.2cm}\begin{center}+\begin{minipage}{80ex}\begin{alltt}}{\end{alltt}\end{minipage}\end{center}\vspace{-0.6cm}\end{figure}}+\newrgbcolor{green}{0.2 1 0.2}+\newrgbcolor{blue}{0.4 0.4 1}+\newrgbcolor{yellow}{0.98 0.98 0}+\newrgbcolor{red}{0.8 0 0}++\psset{framesep=1pt}+\newcommand{\bred}[1]{\psframebox[linecolor=red,fillstyle=solid,fillcolor=red]{#1\rule[-0.3ex]{0ex}{1.9ex}}}+\newcommand{\bgreen}[1]{\psframebox[linecolor=green,fillstyle=solid,fillcolor=green]{#1\rule[-0.3ex]{0ex}{1.9ex}}}+\newcommand{\bblue}[1]{\psframebox[linecolor=blue,fillstyle=solid,fillcolor=blue]{#1\rule[-0.3ex]{0ex}{1.9ex}}}+\newcommand{\byellow}[1]{\psframebox[linecolor=yellow,fillstyle=solid,fillcolor=yellow]{#1\rule[-0.3ex]{0ex}{1.9ex}}}++\newcommand{\oute}[5]+{\rput(#1,#2){\rnode{#3}{\psframebox{\strut\texttt{#4}}}~#5}}+\newcommand{\outem}[5]+{\rput(#1,#2){\rnode{#3}{\psframebox[fillstyle=solid,fillcolor=magenta]{\strut\texttt{#4}}}~#5}}++\newcommand{\negskip}{\vspace{-1ex}}++\newcommand{\quoted}[1]{'#1'}++++\title{{\huge{}Hat-Explore}\\Version 2.04\\Users' Manual}+\author{Olaf Chitil}++\begin{document}+\maketitle+++\section{Introduction}++\hatexplore is a tool for free, source-based navigation through a computation.+Like a conventional debugger hat-explore highlights our current position in the computation in the program source and shows a stack backtrace of function calls. In contrast to conventional debuggers we are free of the sequential evaluation order when stepping through the computation. From any function call we can go down to any further function called by it, to a function call in the same function definition, or upwards to the caller of the current function call.++Because arguments and the result are shown for each function call, it is easier to determine which function is incorrect. You can also mark reductions as correct/incorrect which enables the tool to pinpoint the bug to a smaller and smaller slice of the program. +++\section{The Screen Layout}++The display of \hatexplore is divided into two parts: the call stack and the source. The stack shows a sequence of reductions, where each reduction called the function applied in the reduction below. The last reduction on the call stack is called the current reduction, the reduction that is currently in focus.+In the source the \emph{call site} of the redex of the current reduction is underlined. ++The following shows the display from the middle of a session:+\newpage++\begin{shot}+==== Hat-Explore 2.04 ==== Call 1/2 =============================+ 1. \bblue{main = \{IO\}}+ 2. \bblue{sort "sort" = "os"}+ 3. \bblue{sort "ort" = "o"}+ 4. \underline{\bblue{insert \quoted{o} "r" = "o"}}+---- Insert.hs ---- line 1 to 9 ----------------------------------+main = putStrLn (sort "sort")++sort :: Ord a => [a] -> [a]+sort [] = []+sort (x:xs) = \underline{\bblue{insert x (sort xs)}}++insert :: Ord a => a -> [a] -> [a]+insert x [] = [x]+insert x (y:ys) = if x <= y then x : ys else y : (insert x ys)+\end{shot}++Optionally the \emph{definition site} of the function of the redex can also be highlighted.++\section{Navigation through the Computation}+++You navigate through computation via the cursor keys: up to the caller of the current reduction, down to the first callee, and left and right to siblings. ++In the program source the call sites of the siblings are also highlighted but not underlined like the current redex (display shortened):++\begin{shot}+==== Hat-Explore 2.04 ==== Call 2/2 =============================+5. \underline{\bblue{sort "t" = "t"}}+---- Insert.hs ---- line 1 to 9 ---------------------------------+main = putStrLn (sort "sort")++sort :: Ord a => [a] -> [a]+sort [] = []+sort (x:xs) = \bblue{insert x (}\underline{\bblue{sort xs}}\bblue{)}++insert :: Ord a => a -> [a] -> [a]+insert x [] = [x]+insert x (y:ys) = if x <= y then x : ys else y : (insert x ys)+\end{shot}++So, given the state of the last screenshot, pressing the left cursor key yields (display shortened): ++\begin{shot}+==== Hat-Explore 2.04 ==== Call 1/2 =============================+5. \underline{\bblue{insert \quoted{r} "t" = "r"}}+---- Insert.hs ---- line 1 to 5 ---------------------------------+main = putStrLn (sort "sort")++sort :: Ord a => [a] -> [a]+sort [] = []+sort (x:xs) = \underline{\bblue{insert x (sort xs)}}+\end{shot}++\noindent+A move to the caller via cursor key up or to a callee via cursor key down usually requires a complete change of the displayed source, because the call sites are further away. So pressing cursor key down yields:++\begin{shot}+==== Hat-Explore 2.04 ==== Call 1/1 =============================+6. \underline{\bblue{\quoted{o} <= \quoted{r} = True}}+---- Insert.hs ---- line 6 to 9 ---------------------------------++insert :: Ord a => a -> [a] -> [a]+insert x [] = [x]+insert x (y:ys) = if \underline{\bblue{x <= y}} then x : ys else y : (insert x ys)+\end{shot}++\noindent+Pressing cursor key up once returns to the last but one screen. Pressing cursor key up again yields:++\begin{shot}+==== Hat-Explore 2.04 ==== Call 1/2 =============================+4. \underline{\bblue{sort "ort" = "o"}}+---- Insert.hs ---- line 4 to 7 ---------------------------------+sort [] = []+sort (x:xs) = \bblue{insert x (\underline{sort xs})}++insert :: Ord a => a -> [a] -> [a]+\end{shot}++The call site of a parent or child can be in a different module. \hatexplore lazily loads a module source when it is needed and displays it.+++\section{Algorithmic Debugging}++\hatexplore supports algorithmic debugging, that is, error-location based on declarations of the user on which reductions are correct. We can declare if the current reduction is correct or incorrect with respect to our intentions and also change and take back any previous such declaration. The tool uses several colours for highlighting: correct reductions are \bgreen{green}, incorrect ones are \byellow{yellow}, unknown/undeclared ones are \bblue{blue}. When the tool identifies a reduction as faulty, it is highlighted in \bred{red}.++Let us work step by step through an example session for the faulty insertion sort program. The tool starts with the reduction of \texttt{main}. +(There is no call site of \texttt{main}, hence its definition is underlined.)++\begin{shot}+==== Hat-Explore 2.04 ==== Call 1/1 =============================+ 1. \underline{\bblue{main = \{IO\}}}+++---- Insert.hs ---- lines 1 to 3 --------------------------------+\underline{main = putStrLn (sort "sort")}++sort :: Ord a => [a] -> [a]+\end{shot}++\noindent+We cannot say if this reduction is correct, but only press cursor down to look at the children:++\begin{shot}+==== Hat-Explore 2.04 ==== Call 1/2 =============================+ 1. \bblue{main = \{IO\}}+ 2. \underline{\bgreen{putStrLn "os" = \{IO\}}}++---- Insert.hs ---- lines 1 to 3 ---------------------------------+main = \underline{\bgreen{putStrLn (}\bblue{sort "sort"}\bgreen{)}}++sort :: Ord a => [a] -> [a]+\end{shot}++\noindent+The first child is a reduction of a trusted function and hence assumed to be correct. So we press cursor right to look at the second child:++\begin{shot}+==== Hat-Explore 2.04 ==== Call 2/2 =============================+ 1. \bblue{main = \{IO\}}+ 2. \underline{\bblue{sort "sort" = "os"}}++---- Insert.hs ---- lines 1 to 3 --------------------------------+main = \bgreen{putStrLn (}\underline{\bblue{sort "sort"}}\bgreen{)}++sort :: Ord a => [a] -> [a]+\end{shot}++\noindent+This reduction disagrees with our intentions and hence we+press 'w' to declare the reduction as wrong:+\newpage++\begin{shot}+==== Hat-Explore 2.04 ==== Call 2/2 =============================+ 1. \bblue{main = \{IO\}}+ 2. \underline{\byellow{sort "sort" = "os"}}++---- Insert.hs ---- lines 1 to 3 --------------------------------+main = \bgreen{putStrLn (}\underline{\byellow{sort "sort"}}\bgreen{)}++sort :: Ord a => [a] -> [a]+\end{shot}++\noindent+To find out why the reduction is wrong we have to look at the children, so we press cursor down:++\begin{shot}+==== Hat-Explore 2.04 ==== Call 1/2 =============================+ 1. \bblue{main = \{IO\}}+ 2. \byellow{sort "sort" = "os"}+ 3. \underline{\bblue{insert \quoted{s} "o" = "os"}}+---- Insert.hs ---- lines 3 to 5 --------------------------------+sort :: Ord a => [a] -> [a]+\emph{sort [] = []+sort (x:xs) = \underline{\bblue{insert x (sort xs)}}}+\end{shot}++\noindent+We press 'c' to declare the reduction as correct and then press cursor right to look at the second child:+\begin{shot}+==== Hat-Explore 2.04 ==== Call 2/2 =============================+ 1. \bblue{main = \{IO\}}+ 2. \byellow{sort "sort" = "os"}+ 3. \underline{\bblue{sort "ort" = "o"}}+---- Insert.hs ---- lines 3 to 5 --------------------------------+sort :: Ord a => [a] -> [a]+\emph{sort [] = []+sort (x:xs) = \bgreen{insert x (}\underline{\bblue{sort xs}}\bgreen{)}}+\end{shot}++\noindent+We press 'w' to declare the reduction as wrong and then press cursor down to inquire further:+\newpage+\begin{shot}+==== Hat-Explore 2.04 ==== Call 1/2 =============================+ 2. \byellow{sort "sort" = "os"}+ 3. \byellow{sort "ort" = "o"}+ 4. \underline{\bblue{insert \quoted{o} "r" = "o"}}+---- Insert.hs ---- lines 3 to 5 --------------------------------+sort :: Ord a => [a] -> [a]+\emph{sort [] = []+sort (x:xs) = \underline{\bblue{insert x (sort xs)}}}+\end{shot}++\noindent+We press 'w' to declare the reduction as wrong:+\negskip+\begin{shot}+==== Hat-Explore 2.04 ==== Call 1/2 =============================+ 2. \byellow{sort "sort" = "os"}+ 3. \byellow{sort "ort" = "o"}+ 4. \underline{\bred{insert \quoted{o} "r" = "o"}}+---- Insert.hs ---- lines 3 to 5 --------------------------------+sort :: Ord a => [a] -> [a]+sort [] = []+sort (x:xs) = \underline{\bred{insert x (}\bblue{sort xs}\bred{)}}+\end{shot}++\noindent+So the reduction \texttt{insert \quoted{o} "r" = "o"} is faulty. We have located the fault, it must be in the definition of \texttt{insert}. If we are not convinced, we can still press cursor down to see that \texttt{insert \quoted{o} "r" = "o"} has only a single child, a reduction of a trusted function, which is assumed to be correct:+\negskip+\begin{shot}+==== Hat-Explore 2.04 ==== Call 1/1 =============================+ 3. \byellow{sort "ort" = "o"}+ 4. \bred{insert \quoted{o} "r" = "o"}+ 5. \underline{\bgreen{\quoted{o} <= \quoted{r} = True}}+---- Insert.hs ---- lines 7 to 9 --------------------------------+insert :: Ord a => a -> [a] -> [a]+\emph{insert x [] = [x]+insert x (y:ys) = if \underline{\bgreen{x <= y}} then x : ys else y : (insert x ys)}+\end{shot}++Declaring the (in)correctness of the current reduction is separate from navigation; it does not automatically navigate to a new reduction. Thus we are free to declare (in)correctness of reductions in any order. In practice it is often much easier to recognise an incorrect reduction than being sure that a reduction is correct. \hatexplore allows us to look at all children of a redex, determine that one of them is incorrect, and continue exploring that reduction, without having to consider the correctness of its siblings. +We might not even rely on algorithmic debugging at all but just use declarations of (in)correctness as memory hints.++\section{Program Slicing}++\hatexplore marks a faulty reduction and the definition of the faulty function when it has been identified. However, that happens only rather late, after enough information about correct and incorrect reductions is available.+Hence in addition, \hatexplore offers to mark the definitions of all functions within which the fault must be. These definitions comprise the faulty slice. With increasing information about correct and incorrect reductions the faulty slice shrinks until the faulty reduction has been identified.++\emph{This feature is turned off by default and has to be turned on by pressing \texttt{f} for faulty slice. Computation of the faulty slice can be proportional to the size of the trace, hence it is only practically useful for small traces.If \hatexplore seems to freeze, this is probably because it takes very long to compute the slide.}++In the example session of the previous section a faulty slices is marked in \emph{italics} (\hatexplore actually uses \textbf{bold text}). When \texttt{sort "sort" = "os"} is declared as wrong, the definition of \texttt{sort} and \texttt{insert} become the faulty slice. When \texttt{insert \quoted{o} "r" = "o"} is declared as wrong, the definition of \texttt{sort} is subtracted from the faulty slice, leaving only the definition of \texttt{insert}.++While we declare nodes as correct or incorrect, the slice of definitions that must contain a fault keep shrinking. The shrinking of the faulty slice shows us that we are making progress, it may quickly exclude large parts of the program, possibly parts that had been wrongly suspected, and when the faulty slice has become small we may spot the fault straight away without even having to continue algorithmic debugging to its end.+In practice we also often skip declaring the correctness of a node; for example, because it might be hard (large input or output) or impossible (values of abstract data types) to determine.++Exploration with \hatexplore may uncover several independent faults, each of which has a faulty slice. \hatexplore marks the faulty slice that belongs to the current reduction or, if the current reduction is correct, the faulty slice belonging to the next faulty reduction upwards on the stack.+++\section{Smaller Faulty Slices}++The faulty slice can be made smaller without additional input from us. When a reduction $f \ldots = \ldots$ is faulty, it is not necessary to add the whole definition of function $f$ to the faulty slice. For a specific reduction usually only parts of the definition body of the reduced function are evaluated because of pattern matching, conditionals and lazy evaluation. The fault can only be in that part of the definition that was actually evaluated for that particular reduction. Evaluated parts of the definition are the call sites of the children of the node plus demanded constants, data constructor applications and literals.\footnotemark[1] \hatexplore optionally only shows this smaller faulty slice. Pressing \texttt{p} toggles between partial and full slices. In our example program the ``else'' branch was never evaluated for the current, incorrect reduction.++\negskip++\begin{shot}+==== Hat-Explore 2.03 ==== Call 2/2 | faulty slice | executed ===+ 1. \bblue{main = \{IO\}}+ 2. \byellow{sort "sort" = "os"}+ 3. \underline{\byellow{sort "ort" = "o"}}+---- Insert.hs ---- line 3 to 9 ----------------------------------+sort :: Ord a => [a] -> [a]+sort [] = \emph{[]}+sort (x:xs) = \emph{\bgreen{insert x (}\underline{\byellow{sort xs}}\bgreen{)}}++insert :: Ord a => a -> [a] -> [a]+insert x [] = \emph{[x]}+insert x (y:ys) = \emph{if x <= y} then \emph{x : ys} else y : (insert x ys)+\negskip\negskip\negskip\negskip+\end{shot}++\footnotetext[1]{If a constant is evaluated, it is impossible to determine if it was demanded for the currently considered reduction or a different part of the computation, because constants are shared. For most data constructor applications and literals, the entry in the \Hat trace contains no indication if they were ever demanded in the computation. To be on the safe side, in all such cases the expression has to be included in the slice, if the surrounding expression construct is included.}++Unfortunately it is no longer true that the fault has to be within the faulty slice. The fault may also be within the patterns on the left-hand-sides of the defining equations.\footnote[2]{The Hat trace does not include any information on the pattern matching process. For an unsuccessful match it cannot be determined which parts of a pattern were used and exactly where matching failed. The trace has no information on locations of patterns in the source. Nonetheless, \Hat works fine for computations that abort with a pattern match failure, as Section~\ref{start} demonstrates.} The fault might even be that an equation that should be there is missing. This last possibility cannot be expressed well by marking any slice at all.+++\section{Code Coverage}++By declaring the root reduction of the computation, \texttt{main~= \{IO\}}, as incorrect and asking \hatexplore to mark only the evaluated faulty slice, we can obtain the slice of the program that was evaluated at all during the whole computation.++\begin{shot}+==== Hat-Explore 2.03 ==== Call 1/1 | faulty slice | executed ===+ 1. \underline{\byellow{main = \{IO\}}}+++---- Insert.hs ---- line 1 to 9 ---------------------------------+\underline{main = \emph{putStrLn (sort "sort")}}++sort :: Ord a => [a] -> [a]+sort [] = \emph{[]}+sort (x:xs) = \emph{insert x (sort xs)}++insert :: Ord a => a -> [a] -> [a]+insert x [] = \emph{[x]}+insert x (y:ys) = \emph{if x <= y} then \emph{x : ys} else \emph{y : (insert x ys)}+\end{shot}++\noindent +So \hatexplore can serve as a code coverage tool.+++\section{Trusting}++\Hat supports a notion of trusting modules. The computation of these modules is not traced. The reduction of a trusted function is still recorded in the trace. For example, \texttt{length "hi" = 2} may be recorded, but not its recursive call \texttt{length "i" = 1}. So leafs of the computation tree can be reductions of trusted functions. \hatexplore assumes by default that these reductions are correct.++Trusted functions can be higher-order and the functional arguments may be normal untrusted functions, for example \texttt{map myInc [1,2,3] = [2,3,4]}. In that case the reduction of the trusted function can have children, namely the reductions of the passed untrusted functions. So \texttt{map myInc [1,2,3] = [2,3,4]} has the children \texttt{myInc 1 = 2}, \texttt{myInc 2 = 3} and \texttt{myInc 3 = 4}. In general, trusting causes parts of a computation tree to be ``cut out'', even out of the middle of the tree. If a trusted reduction has children, it cannot assumed to be correct by default.++The children of trusted higher-order functions have call sites within trusted modules. Displaying these call sites would contradict the idea of a trusted module whose implementation is irrelevant. So when the current reduction is the child of a trusted reduction, \hatexplore highlights the call site of the trusted parent instead of the child; it does so in a different style to indicate the different situation. The children of such a reduction without call site are again reductions with call site. So there is no danger of us losing orientation because we might have to make a long sequence of navigation steps without highlighting of call sites.++\begin{shot}+\negskip\negskip\negskip+==== Hat-Explore 2.03 ==== Call 2/4 | faulty slice | executed ===+ 1. \bblue{main = \{IO\}}+ 2. \byellow{sort "sort" = "os"}+ 3. \byellow{foldr insert [] "sort" = "os"}+ 4. \bred{insert 'r' "t" = "r"}++---- FoldrInsert.hs ---- line 3 to 9 -----------------------------+sort :: Ord a => [a] -> [a]+sort xs = \underline{foldr insert [] xs}++insert :: Ord a => a -> [a] -> [a]+insert x [] = [x]+insert x (y:ys) = \emph{if x <= y} then \emph{x : ys} else y : (insert x ys)+\end{shot}+++\section{Constants}++A constant definition, such as \texttt{nats = [0..]}, has to be handled specially in the computation tree. In a computation the definition body is only evaluated once and the value is shared by all calls (i.e. uses) of the constant in the program. Because of this sharing the computation is not a tree but a directed graph. Navigation into the computation of a constant is natural. Where to go back up is also uniquely identified by the information in the stack.++Because constant definitions may be (mutually) recursive, the computation graph may be cyclic. Algorithmic debugging only works for trees or acyclic graphs. It is currently the responsibility of the user to be aware that algorithmic debugging may not be able to locate a faulty reduction within the computation of mutually recursive functions. The faulty slice is still correct, but it may never shrink further than a set of mutually recursive definitions.+++\section{Other Starting Points}\label{start}++Normally \hatexplore starts with the reduction of \texttt{main}. Although paths through the computation tree are only logarithmic in the size of the tree, a reduction of interest may still be far away from the root. ++Other viewing tools such as \hattrail and \hatobserve may give quicker access to a reduction of interest. Hence both of them have the option to switch to \hatexplore, starting at the reduction that we just investigated in the other tool. ++Experience shows that faults are often not far from the observed error. Hence if a computation aborts with a runtime error, \hattrail starts directly at the reduction that raised the runtime error. For example, a slightly modified version of our insertion sort causes a pattern match failure. \hatexplore starts as follows, displaying the error value as \texttt{\_|\_} (bottom):++\begin{shot}+==== Hat-Explore 2.03 ==== Call 1/2 | faulty slice | complete ===+ 4. \bblue{sort "rt" = _|_}+ 5. \bblue{sort "t" = _|_}+ 6. \underline{\bblue{insert \quoted{t} [] = _|_}}+---- Insert.hs ---- line 1 to 9 ---------------------------------+sort :: Ord a => [a] -> [a]+sort [] = []+sort (x:xs) = \underline{\bblue{insert x (sort xs)}}++insert :: Ord a => a -> [a] -> [a]+insert x (y:ys) = if x <= y then x : ys else y : (insert x ys)+\end{shot}+++\section{Command Overview}++Pressing \texttt{h} yields the complete list of commands understood by \hatexplore:++\begin{alltt}+ cursor down    follow current call+ cursor up      go back to caller of current call+ cursor left    go to call further left in current definition body+ cursor right   go to call further right in current definition body++ c     declare current equation to be correct (wrt. intentions)+ w     declare current equation to be wrong (wrt. intentions)+ n     undo declaration of correctness (neither correct nor wrong)+ a     amnesia - forget all declarations as correct or wrong++ f     toggle between showing fault set or just current definition+ p     toggle between showing used part of definition or full++ <     change to alphabetically preceeding module+ >     change to alphabetically succeeding module++ t     scroll source window to top of code+ u     scroll source window upwards+ d     scroll source window downwards+ b     scroll source window to bottom of code++ r              redraw everything after change of window size+ h or ?         display this help text++ q              quit+++Meaning of colours:+green - correct, amber - wrong, blue - unkown, red - faulty.+\end{alltt}++\end{document}
+ docs/hatuser.tex view
@@ -0,0 +1,1526 @@+% Created: 13.9.2000+% Last Update: 14.6.2002 (Malcolm)++\documentclass[12pt]{article}++\usepackage[a4paper]{geometry}+\usepackage{alltt}+\usepackage{amssymb}++\newif\ifpdf+\ifx\pdfoutput\undefined+  \pdffalse+\else+  \pdfoutput=1+  \pdftrue+\fi++\ifpdf+  \usepackage[bookmarks       = true,+              bookmarksopen   = true,+              pdfhighlight    = /N,+              hypertexnames   = false,+              breaklinks      = true,+              linkbordercolor = {1 1 1},+              pagebackref     = true,+              pdfborder       = {0 0 0}]{hyperref}+  \usepackage{graphicx}+  \pdfcompresslevel=9+\else+  \usepackage{graphicx}+\fi++%------------------------------------------------------------------------------++\newenvironment{code}{\begin{quote}\begin{alltt}}{\end{alltt}\end{quote}}++\newcommand{\emptyBox}{\Box}+\newcommand{\dashedBox}{\Box\hspace{-9pt}\angle}+\newcommand{\crossBox}{\boxtimes}+\newcommand{\within}{\vartriangleright}+\newcommand{\com}[1]{\texttt{#1}}++%------------------------------------------------------------------------------++\pagestyle{plain}++\begin{document}++\title{{\Huge{}Hat -- The Haskell Tracer}\\Version 2.04\\Users' Manual}+\author{The ART Team}+\date{29 April 2005}+\maketitle+\vspace{-6ex}++\thispagestyle{empty}++\tableofcontents++%------------------------------------------------------------------------------++\newpage+\section{Introduction}\label{introduction}++Hat is a source-level tracer for Haskell (the \emph{Ha}skell+\emph{T}racer). It is a tool that gives the user access to otherwise+invisible information about a computation. Thus Hat helps locating+errors in programs. However, it is also useful for understanding how+a correct program works, especially for program maintenance. Hence+we avoid the popular name ``debugger''. Note that a profiler, which+gives access to information about the time or space behaviour of a+computation, is also a kind of tracer. However, Hat is not intended+for that purpose. Hat measures neither time nor space usage.++Conventional tracers (debuggers) for imperative languages allow+the user to step through the computation, stop at given points and+examine variable contents.  This tracing method is unsuitable for a+lazy functional language such as Haskell, because its evaluation order+is complex, function arguments are usually unwieldy large unevaluated+expressions and generally computation details do not match the user's+high-level view of functions mapping values to values.++Hat is an offline tracer: First the specially compiled program runs as+normal, except that additionally a trace is written to file. Second,+after the computation has terminated, the trace is viewed with a+number of browsing tools.++Hat can be used for computations that terminate normally, that+terminate with an error message or that are interrupted by the+programmer (because they do not terminate).++The trace consists of high-level information about the computation. It+describes each reduction, that is, the replacements of an instance+of a left-hand side of an equation by an instance of its right-hand+side, and the relation of the reduction to other reductions.++Because the trace describes the whole computation, it is huge.+Hence the programmer uses tools to selectively view the fragments of+the trace that are of interest.  Hat includes a number of+viewing tools for that purpose, for example +hat-observe, hat-trail, hat-view, hat-detect, and hat-stack.+Each tool shows fragments of the computation in a particular way,+highlighting a specific aspect.+++%==============================================================================++\section{Obtaining the Trace of a Computation}++To obtain a trace of a computation of a program, the program has to+be compiled specially, using \texttt{hmake} with either \texttt{nhc98}+or \texttt{ghc}, and then run.++Compile the program using \texttt{hmake} and the \texttt{-hat} option;+you may want to choose your compiler as well, e.g.+\begin{verbatim}+    hmake -ghc -hat Prog+\end{verbatim}+(Note that \texttt{hmake Prog} both compiles the program and links+it to an executable, whereas \texttt{hmake Prog.hs} only compiles+the module and its dependents without linking.)++What \texttt{hmake} does is this: all the modules of the+program are transformed to tracing versions with the pre-processor+\texttt{hat-trans}.  This preprocessor generates a new module for each original module; these generated Haskell modules are stored in a directory +\texttt{Hat}.  The generated modules+are compiled and linked using an ordinary compiler with the extra+option \texttt{-package hat}.  The \texttt{hat} package contains+interface files and a link-library that are needed by the transformed+program.++You can invoke \texttt{hat-trans} and the compiler manually if you+wish, but \texttt{hat-trans} generates and reads its own special kind+of module interface files (\texttt{.hx} files) and therefore modules+must be transformed in the same dependency order as normal compilation.+Hence, it is much easier simply to let \texttt{hmake} do all the work.++Note that the \texttt{hat-trans} preprocessor does not insert the+complete file paths of the original source modules into the generated+modules. The trace viewers assume that the source modules are in the+same directory as the executable.++\subsection{Compilation with nhc98}++Tracing makes computations use more heap space. As a rough rule of+thumb, traced computations require 3 times as much heap space as+untraced ones. However, because traced computations allocate (and+discard) much memory, it is useful to choose an even larger heap size+to reduce garbage collection time.  The preset default heap size for+an untraced program compiled by \texttt{nhc98} is 400KB; you will+probably want to increase this to at least 2MB.  For example, you can+set the heap size at compile (link) time with \texttt{+CTS -H10m -CTS}+or for a specific computation with \texttt{+RTS -H10m -RTS} to a ten+megabyte heap.++\subsection{Computation}++The traced computation behaves exactly like the untraced one, except+that it is slower (currently about 50 times slower), +and additionally writes a trace to file.++If it seems that the computation is stuck in a loop, then force halting+by keying an interrupt (usually \texttt{Ctrl-C}).  After termination of+the computation (normal termination or caused by error or interrupt)+you can explore the trace with any of the programs described in the+following sections.++The computation of a program \emph{name} creates the trace files+\emph{name}\texttt{.hat}, \emph{name}\texttt{.hat.bridge} and+\emph{name}\texttt{.hat.output}. The latter is a copy of the whole+output of the computation. The first is the actual trace. It can+easily grow to several hundred megabytes. To improve the runtime of+the traced computation you should create the trace file on a local+disc, not on a file system mounted over a network. The trace files+are always created in the same directory as the executable program.+++\subsection{Trusting}\label{trusting}++Hat enables you to trace a computation without recording every+reduction.  You can \emph{trust} the function definitions of a+module. Then the calls of trusted functions from trusted functions+are not recorded in the trace.++Note that a call of an untrusted function from a trusted function is+possible, because an untrusted function can be passed to a trusted+higher-order function. These calls are recorded in the trace.++For example, you may call the trusted function \texttt{map} with an+untrusted function \texttt{prime}: \texttt{map prime [2,4]}. If this+call is from an untrusted function, then the reduction of \texttt{map+prime [2,4]} is recorded in the trace, but not the reductions of+the recursive calls \texttt{map prime [4]} and \texttt{map prime+[]}. However, the reductions of \texttt{prime 2} and \texttt{prime 4}+are recorded, because \texttt{prime} is untrusted.++You should trust modules in whose computations you are not interested.+Trusting is desirable for the following reasons:+\begin{itemize}+\item to keep the size of the trace file smaller (main point)+\begin{itemize}+\item to save file space+\item to avoid unnecessary detail when viewing the trace+\end{itemize}+\item to reduce the runtime of the traced program (slightly)+\end{itemize}++If you want to trust a module, then compile it for tracing as normal+but with the extra option \texttt{-trusted}.  (A plain object file+compiled without any tracing option cannot be used.)  By default the+Prelude and the standard libraries are trusted.+++%==============================================================================++\section{Viewing a Trace}\label{viewing}++Although each tool gives a different view on the trace, they all have+some properties in common.++\subsection{Arguments in Most Evaluated Form}++The tools show function arguments in evaluated form, more+precisely: as far evaluated as the arguments are at the end of the+computation. For example, although in a computation the unevaluated+expression \texttt{(map (+5) [1,2])} might be passed to the function+\texttt{length}, the tools show the function application as+\texttt{length [1+5,2+5]} or \texttt{length [\_,\_]} if the list+elements are unevaluated.++\subsection{Special Expressions}++\paragraph{Unevaluated expressions}++Tools do not usually show non-value subexpressions.  The underscore+\texttt{\_} represents these unevaluated expressions.  (The `uneval'+option can be set interactively if you wish to replace underscores+with the full representation of the unevaluated expression.)++\paragraph{$\lambda$-abstractions}++A $\lambda$-abstraction, as for example +\verb?\xs-> xs ++ xs?,+is represented simply by \verb?(\..)?.++\paragraph{The undefined value $\bot$}++If the computation is aborted because of a run-time error or+interruption by the user, then evaluation of a redex may have begun,+but not yet resulted in a value.  We call the result of such a redex+\emph{undefined} and denote it by $\bot$ (\texttt{\_|\_} in ASCII+form).++A typical case where we obtain $\bot$ is when in order to compute+the value of a redex the value of the redex itself is needed. The+occurrence of such a situation is called a \emph{black hole}. The+following example causes a black hole:++\begin{code}+a = b + 1+b = a + 1++main = print a+\end{code}++When the program is run, it aborts with an error message saying+that a black hole has been detected.  The trace of the computation+contains several $\bot$'s.++\paragraph{Trusted Expressions}++The symbol \texttt{\{?\}} is used to represent an expression that+was not recorded in the trace, because it was trusted.++\subsection{Combination of Viewing Tools}++Each tool gives a unique view of a computation.  These views are+complementary and it is productive to use them together.  From+most of the tools you can at any+time change to any of the other tools, starting there at exactly+the point of the trace at which you left the other tool. So after+using one tool to track a bug to a certain point you can change to+another tool to continue the search or confirm your suspicion.++\subsection{The Running Example}++The following faulty program is used as example in the description+of most viewing tools:+\begin{quote}+\begin{alltt}+main = let xs :: [Int]+           xs = [4*2, 5`div`0, 5+6]+       in  print (head xs, last' xs)++last' (x:xs) = last' xs+last' [x] = x+\end{alltt}+\end{quote}+++%==============================================================================++\section{Hat-Observe}\label{hat-observe}++Hat-observe enables you to observe the value of top-level variables,+that is, functions and constants. Hat-observe shows all reductions of+a variable that occurred in the traced computation. Thus for a function+it shows all the arguments with which the function was called during+the computation together with the respective results.++It is possible to use hat-observe in batch-mode from the command line,+but the main form of use is as an interactive tool.  The interactive+mode provides more comprehensive facilities for filtering the output+than batch mode.++%\subsection{Simple Command Line Usage}+%+%Hat-observe shows only variables defined on the top-level to avoid+%problems with locally defined variables capturing free variables.+%+%+%To use hat-observe from the command line enter+%\begin{quote}+%\texttt{hat-observe [-v] [-r]}~\emph{variable}~\texttt{[in}~\emph{variable'}\texttt{]}~\emph{programname}\texttt{[.hat]}+%\end{quote}+%where \emph{programname} is the name of the traced program, and+%\emph{variable} and \emph{variable'} are top-level functions or+%constants of the program.+%+%\begin{description}+%\item{\texttt{-v}} verbose mode\newline +%Normally unevaluated subexpressions of arguments or results are just shown as \texttt{\_}. With this option they are shown in full.+%\item{\texttt{-r}} nonrecursive mode \newline+%Recursive function calls are not shown.+%\end{description}+%+%If a second variable is given after the keyword \texttt{in}, then only the calls of the first variable from the right-hand-side of the second variable are shown.+%+%\subsection{Examples}+%+%\begin{quote}+%\begin{alltt}+%hat-observe "last'" Example+%\end{alltt}+%\end{quote}+%shows +%\begin{quote}+%\begin{alltt}+%last' (8:_:_:[]) = _|_+%last' (_:_:[]) = _|_+%last' (_:[]) = _|_+%last' [] = _|_+%\end{alltt}+%\end{quote}+%whereas+%\begin{quote}+%\begin{alltt}+%hat-observe -v "last'" Example+%\end{alltt}+%\end{quote}+%also shows the unevaluated subexpressions+%\begin{quote}+%\begin{alltt}+%last' (8:(div 5 0):5+6:[]) = _|_+%last' ((div 5 0):5+6:[]) = _|_+%last' (5+6:[]) = _|_+%last' [] = _|_+%\end{alltt}+%\end{quote}+%and+%\begin{quote}+%\begin{alltt}+%hat-observe -r "last'" Example+%\end{alltt}+%\end{quote}+%only shows the single non-recursive call of \texttt{last'}+%\begin{quote}+%\begin{alltt}+%last' (8:_:_:[]) = _|_+%\end{alltt}+%\end{quote}+%and finally+%\begin{quote}+%\begin{alltt}+%hat-observe "last'" in "last'" Example+%\end{alltt}+%\end{quote}+%only shows the recursive calls of \texttt{last'}+%\begin{quote}+%\begin{alltt}+%last' (_:_:[]) = _|_+%last' (_:[]) = _|_+%last' [] = _|_+%\end{alltt}+%\end{quote}++\subsection{Starting \& Exiting}++To start hat-observe as an interactive tool, simply enter+\begin{quote}+\texttt{hat-observe} \emph{prog}\texttt{[.hat]}+\end{quote}+at the command line, where \emph{prog} is the name of the traced+program.++\subsection{The Help Menu}++Enter \texttt{:h} (\texttt{:help}) to obtain a short overview of+the commands understood by hat-observe.  All commands begin with a+`\texttt{:}', and can be shortened to any prefix of the full name.++\subsection{Observing for Beginners: Using the Wizard}++If you use hat-observe for the first time, you might want to start+by using the observation \emph{wizard}. Simply enter the command+\com{:observe} with no other arguments. The tool will then ask+questions about the reductions you are interested in. Eventually,+it will show the resulting query and start the observation.  This way+you can quickly learn what queries look like.++\subsection{Making Simple Observations}++Observations of a function are made with the \com{:observe} command,+or for simplicity, just by entering the name of the function at+the prompt.  For instance, enter \com{:observe}~\emph{f}, or simply+\emph{f}, to obtain all reductions of \emph{f}.++To avoid redundant output, equivalent reductions of the identifier+are omitted in the display (\com{:set unique}).  You can change+this behaviour in order to see all reductions, even identical ones+(\com{:set all}).  In future there will also be an option to see+only the most general reductions.  A reduction of an identifier is+considered more general than another if all its arguments on the+left-hand-side are less defined (due to lazy evaluation) and/or if+its result on the right-hand-side is more fully defined.++\subsection{Exploring What to Observe}++If you forgot the correct spelling of a function identifier you want+to observe or you do not know the program well, you may want to see+a list of all function identifiers which can be observed.  With the+\com{:info} command you can browse the list of all top-level function+identifiers which were used during the computation, and how many times+they were used.++\subsection{Filtering Reductions}++Even when only unique reductions are shown, some observations may still+result in an excessively large number of displayed equations. You only+want to see those reductions in which you are particularly interested.+There are several ways to decrease the number of reductions shown.++\subsubsection{Non-Recursive Mode}++Hat-observe can omit recursive calls of the given function.  If all the+top-most calls of a function are correct, then all its recursive calls+within the function itself are \emph{likely} to be correct as well. If+there are any erroneous recursive calls, their incorrect behaviour+at least had no effect on the result of the top most calls. To omit+recursive calls of a function, the \com{:set recursive off} command may+be used.  To see recursive calls again, use \com{:set recursive on}.++%\subsubsection{Generalise Equations}+%+%A function may be called several times with the same arguments.+%Hat-observe shows these arguments and the result only once.+%+%Furthermore, because a function may not need full evaluation of its+%arguments, a function call may be more general than another one in+%that the arguments are less evaluated in the first than the second+%one.  If the result is the same or the result for the less general+%arguments is less evaluated, then the display of the application+%to the less general arguments can be omitted.  Use the \com{:set+%generalise on} command to omit the less general equations.++\subsubsection{Observing Calls from a Specific Context}++Another way to restrict the number of reductions being observed is+by observing only calls made from within a specific calling function.+If you are interested in all calls of \texttt{map} from the function+\texttt{myMapper}, try \com{:observe map in myMapper}.++\subsubsection{Specifying Reductions with a Pattern}++You can significantly reduce the number of observed applications+by observing only reductions that are instances of a given pattern.+With a pattern you can specify in which reductions you are particularly+interested.++You can enter a pattern for the whole equation or any prefix of it.+A pattern for an equation consists of a pattern for the left-hand-side+followed by a \texttt{=} and a pattern for the result.  The \texttt{=}+and result pattern may be omitted, as may any of the trailing+argument patterns.++If you wish to skip one argument in the pattern, use an underscore.+An underscore \texttt{\_} in a pattern matches any expression, value,+or unevaluated.  The bottom symbol \texttt{\_|\_} may also be used+in patterns, and matches only unevaluated things.++Examples:+\begin{itemize}+\item To see all applications of \texttt{map} where its first argument is+  \texttt{foo}, enter \com{:observe map foo}.  However, to see all+  applications of \texttt{map} where its \emph{second} argument is+  \texttt{foo}, enter \com{:observe map \_ foo}.++\item To see all applications of \texttt{filter} using first argument+  \texttt{odd} and resulting in an empty list, enter+  \com{:observe filter odd \_ = []}.+\end{itemize}++Infix patterns are also supported, although the fixity and priority+of the operator is not necessarily known, so always use explicit+parentheses around such patterns.++Sugared syntax for strings and lists is supported, e.g.\ \texttt{"Hello+world!"} for a string and \texttt{[1,2,42]} etc. for lists.++\subsubsection{Combination of Filters}++Of course, all methods previously described can be mixed with each+other, as in the following examples.++\texttt{:observe map \_ [1,2,3] in myMapper}++\texttt{:observe filter even (: 1 \_) = \_|\_ in myFunction}++\texttt{:observe fibiterative \_ \_ = 0}++\subsection{Verbose Modes}++There are several modes determining the relative verbosity of the+output.  \com{:set uneval on} shows unevaluated expressions in full,+rather than abbreviating them to underscores.  \com{:set strSugar+off} turns off string sugaring, and \com{:set listSugar off} turns+off sugaring for other kinds of list: in both cases, the effect is+to reveal the explicit cons and nil structures.++\subsection{Browsing a List of Reductions}++After successfully submitting a query in any of the described ways,+the tool searches the given trace file. Depending on the size of+the file and the number of reductions found, the search may take a+considerable time. Progress will be indicated during the scan of the+file. After the scan of the file, additional time might be spent on+filtering the most general reductions matching+the given pattern.++The first $n$ (default 10) observed reductions are then displayed.+More reductions can be displayed by pressing the \texttt{RETURN} key.+The system indicates the availability of additional equations by+prompting with \texttt{--more-->} instead of the usual command prompt.+If more equations are available but you do not wish to see them,+typing anything except the plain RETURN key will cause you to leave+the equation display mode and go back to the normal prompt.++The number of equations displayed per group can be altered by using+the \com{:set group}~\emph{n} command.  The default is 10 reductions at+a time.  The reductions are numbered -- this is to facilitate selection+of an equation for use within the other hat tools.++Attention: because hat-observe uses lazy evaluation to determine the+list of reductions, there may be a delay during which more reductions+are determined.+++\subsection{Display of Large Expressions}++Sometimes expressions may contain very large data structures which+clutter the display.  In order to cope with them the cutoff depth of+the display can be adjusted.  This cutoff value determines the nesting+depth to which nested sub-expressions are printed: any subexpression+beyond this depth is shown as a dark square.  The cutoff depth is+adjusted using the command \com{:set cutoff}~\emph{n}.++In certain circumstances, you simply want to increase or decrease+the cutoff by a small amount.  There are `shortcut' commands+\com{:+}~\emph{n} and \com{:-}~\emph{n} to increase or decrease the+cutoff by \emph{n} respectively.  If \emph{n} is omitted, then+it is assumed to be one.++A data structure may be infinite. Because an \emph{infinite} data+structure is the result of a \emph{finite} computation, it must contain+a cycle. The following example demonstrates how such a cycle is shown.++\begin{quote}+\begin{alltt}+cyclic = 1:2:3:4:cyclic+main = putStrLn (show (take 5 cyclic))+\end{alltt}+\end{quote}++If you observe \texttt{cyclic}, then you obtain+\begin{quote}+\begin{alltt}+cyclic = (cyc1 where cyc1 = 1:2:3:4:cyc1)+\end{alltt}+\end{quote}+++\subsection{Invoking other Viewing Tools}\label{othersFromObserve}++You may eventually find an erroneous reduction.+There are several ways in which you can proceed at this point.++The first way is to start observing functions used in the definition+body of the erroneous function. You will need to check the source code+for functions which might have caused the wrong result. If you suspect+a function \emph{f} to have caused the incorrect behaviour of \emph{g},+it is a good idea to try \com{:observe}~\emph{f}~\com{in}~\emph{g}.++A second way to proceed is to switch to the Algorithmic Debugging tool+\texttt{hat-detect} at this point.+The command \texttt{:detect $n$} starts a separate \texttt{hat-detect}+session for equation number $n$ in a new window (currently only+works under Unix).  See section~\ref{hat-detect} for information+on \texttt{hat-detect}.++Alternatively, you have the choice to use \texttt{hat-trail} on a+reduction you have observed. Use the command \texttt{:trail $n$}+to start a separate instance of \texttt{hat-trail} for equation+number $n$.+++\subsection{Quick reference to commands}++All the commands that are available in hat-observe are summarised in+the following table.++\begin{verbatim}+---------------------------------------------------------------------------+ <query>            observe the named function/pattern+ <RETURN>           show more observations (if available)+ :observe <query>   observe the named function/pattern+ :info              see a list of all observable functions+ :detect <n>        start hat-detect on equation <n>+ :trail <n>         start hat-trail browser on equation <n>+ :source <n>        show the source application for equation <n>+ :Source <n>        show the source definition for identifier in eqn <n>+ :set               show all current mode settings+ :set <flag>        change one mode setting+   <flag> can be: uneval [on|off]      show unevaluated expressions in full+                  strSugar [on|off]    sugar character strings+                  listSugar [on|off]   sugar lists+                  recursive [on|off]   show recursive calls+                  [all|unique]         show all equations or only unique+                  group <n>            number of equations listed per page+                  cutoff <n>           cut-off depth for deeply nested exprs+ :+[n]              short-cut to increase cutoff depth by <n> (default 1)+ :-[n]              short-cut to decrease cutoff depth by <n> (default 1)+ :resize            detect new window size for pretty-printing+ :help              show this help text+ :quit              quit+---------------------------------------------------------------------------+\end{verbatim}+++%==============================================================================++\section{Hat-Trail}++Hat-trail is an interactive tool that enables you to explore a+computation \emph{backwards}, starting at the program output or+an error message (with which the computation aborted). This is+particularly useful for locating an error. You start at the observed+faulty behaviour and work backwards towards the source of the error.++Every reduction replaces an instance of the left-hand side of a program+equation by an instance of its right-hand side. The instance of the+left-hand side ``creates'' the instance of the right-hand side and+is therefore called its \emph{parent}.++Using the symbol $\leftarrow$ to represent the relationship ``comes+from'', (i.e.\ the arrow points from parent to child) here is an+illustrative list showing the parent of every subexpression from the+example in Section~\ref{viewing}.++\begin{quote}+the error message $\leftarrow$ \texttt{last' []}\\+\texttt{last' []} $\leftarrow$ \texttt{last' (\_:[])}\\+\texttt{last' (\_:[])} $\leftarrow$ \texttt{last' (\_:\_:[])}\\+\texttt{last' (\_:\_:[])} $\leftarrow$ \texttt{last' (8:\_:\_:[])}\\+\texttt{last' (8:\_:\_:[])} $\leftarrow$ \texttt{main}\\+\texttt{8} $\leftarrow$ \texttt{4*2}\\+\texttt{4*2} $\leftarrow$ \texttt{xs}\\+\end{quote}++Every subexpression (if it is not a top-level constant such+as \texttt{main}) has a parent. In the example the parent of+\texttt{(8:\_:\_:[])} is \texttt{xs}.  The parent of each subexpression+in an expression can be different from the parent of the expression+itself.++++\subsection{Starting \& Exiting}++Start hat-trail by entering+\begin{quote}+\texttt{hat-trail}~\emph{prog}\texttt{[.hat]}+\end{quote}+at the command line, where \emph{prog} is the name of the program+(the extension \texttt{.hat} is optional).++You can quit this browser at any time by typing the command \emph{:quit}.++\subsection{The Help Menu}++The \emph{:help} command offers short explanations of the main+features of hat-trail, similar to the quick reference of+Section~\ref{trailquickref}.++\subsection{Basic Exploration of a Trace}++The browser window mainly consists of two panes:++\begin{itemize}++\item The program output (and error) pane. \\+Here you can select a part of the program output (or an error message,+if there was one), to show its parent redex in the trace pane for+further exploration.++\item The trail pane. \\+This is the most important pane. In it you explore the trace.+With the cursor keys you request information about different parts+of the trace.  Coloured highlighting is used to show the current and+previous selections.++\end{itemize}++You can pop up a further, very important, window on demand:+\begin{itemize}+\item The source code window. \\+Here part of the source code of the traced program is shown. In the trail+pane, you can ask to see a specific point in the source code (e.g.+where exactly a function in a particular expression was applied), and+the cursor in the source code window is placed at the relevant site+in the appropriate source file.  This is not an editor window, just+a viewer -- type the `q' or `x' key in the window to close it.++\end{itemize}+++\subsubsection{The program output (and error) pane}++Any output (or error message) produced by the traced program is shown+in the top pane.  The output is divided into sections; there is one+section of output for each output action performed by the program. You+select a section of the output with the cursor keys: left/up and+right/down.  The selected section is shown with a coloured highlight.+If the output is very large, only a portion of it is displayed at a+time -- moving left/up at the top of the screen, or right/down at the+bottom, `pages' through the output.  Press the Return key to start+exploring the parent redex for the selected section in the lower+trail pane.++\subsubsection{The trail pane}++Within the trail pane, the display shows a simple `stack' of parent+expressions, one per line.  Each expression line is the parent of+the highlighted subexpression on the line before it.  Within a line,+you can navigate to a subexpression using the cursor keys by one of+two methods, described below.  Pressing the Return key asks for the+parent of the currently selected subexpression, and it is shown on a+new line.  Pressing the Delete or Backspace key removes the current+line and goes back to the previous selection in the stack.++\paragraph{Selecting a subexpression in the trail pane}++There are two methods of navigating within an expression to highlight+a specific subexpression.  The simplest method just uses the right and+left cursor keys.  Repeatedly pressing the right cursor key follows+a pre-order traversal of the underlying expression tree.  Thus,+first an application is highlighted, then the function part, then+each argument, and so on recursively depth-first.  The left cursor+key follows the reverse order.++Alternatively, you can navigate by explicit levels within the+tree.  The up cursor key moves outwards from a subexpression to the+surrounding expression.  The down key moves inwards from an application+to the function position.  The `$[$' and `$]$' keys move left and right+amongst subexpressions at the same level, for instance between a+function and its arguments.+++\paragraph{Folding away part of an expression}++When you are looking at a large expression, it is sometimes difficult+to see its gross structure because of all the detail.  At these times,+it is helpful to be able to shrink certain subexpressions to hide the+detail.  This is represented in the display as a small dark box.++You can explicitly shrink any selected subexpression to a dark box,+or expand a selected box to its full representation, with the `-'+and `+' keys.++Like in the other tools, there is a standard cutoff depth for deeply+nested expressions.  The automatically cutoff expression is denoted by+the same dark box as a manually hidden expression.  Use the \com{:set+cutoff}~\emph{n} command to change the cutoff depth, or the shortcuts+\com{:+}~\emph{n} and \com{:-}~\emph{n} to increase and decrease the+cutoff depth -- if \emph{n} is omitted, the cutoff is increased or+decreased by one.+++\subsubsection{The source code window}\label{source}++Most functions and constants are used at more than one position+in the program.  Hence, when viewing an expression in hat-trail,+it can be very helpful to know exactly which application site is+under examination.  There are a number of direct links to the source+code available.++First, the filename, line, and column number of the currently selected+application or value is always visible in a status line at the top+of the trail pane.  You can use this to help you navigate within your+preferred editor or viewer.++Secondly, the command \com{:source} pops up a simple viewer with the+cursor sitting directly over the application site in the relevant file.+The command can be abbreviated to \com{:s}, and you may find that+this is often quicker and more convenient than using an external+editor or viewer.++Thirdly, if you want to look at the \emph{definition} of the selected+function or constant rather than its individual application site,+the command \com{:Source} again pops up the simple viewer, this time+with the cursor on the definition line.+++\subsubsection{Special syntax}++We have already mentioned that a dark box represents a subexpression+that has been hidden from display, either due to automatic cutoff of+deep nesting, or by explicit request of the user.++There are a number of other special syntactic representations in+the display.++\paragraph{Lists}+A list where some elements are undefined or unevaluated is displayed+as a sequence of nested applications of the normal list constructor+\texttt{(:)}.  However, fully evaluated lists are displayed using+the more compact syntactic sugar of square brackets with elements+separated by commas.  Where the end of list is cutoff (due to the+normal cutoff depth parameter), this can look slight ambiguous.+Is the dark box the final element of the list, or does it represent a+larger tail of the list?  To find out, you need to expand the dark box.++\paragraph{Strings}+Fully evaluated character strings are displayed differently again.+A string is usually shown using the Haskell lexical convention of+double quotes, for example \texttt{"Hi"}.  In this representation,+the string is treated as a single atomic unit for navigation.  If+you really want to select a singe character or substring, then+you must turn string sugaring off (\com{:set strSugar off}) in+order to navigate within the explicit list.++%--------more material here---------------------------------------------------++%However, you can \emph{middle}-click on the string+%and thus change its representation to separate the first character,+%for example \texttt{'H':"i"}. Thus you can select subexpressions+%of a string, but the representation is also more verbose. By+%\emph{middle}-clicking on a longer representation you can change it+%back to a string representation.++%When strings are very long, everything to their right can only be+%reached by cumbersome scrolling. In the menu ``Options'' you can select+%the item ``Choose string-length limit'' to set an upper boundary for+%the length of a string. Abbreviated strings are indicated by dots+%(...) in their middle. These abbreviated strings can still be expanded+%as described in the preceding paragraph.++\paragraph{Control-flow constructs}++The control-flow in a function is determined by conditional expressions+(\texttt{if} \texttt{then} \texttt{else}), \texttt{case} expressions+and guards.  It is often desirable to see why a certain branch was+taken in such a control-flow construct. For example, the problem in+a function definition might not be that it computes a wrong return+value, but that a test is erroneous which makes it select a branch+that returns the wrong value.++A control-flow expression of this nature is shown in the trail as+the value of the guard, condition or case discriminant, placed to+the right of the expression within which it belongs and separated+from it by a bar and a highlighted keyword, e.g.\ \texttt{| if False}+or \texttt{| case EQ}.++Strictly speaking, the expression to the left of the bar is the parent+of the expression on the right, but the tool displays them together+for clarity since the guard, condition, or case makes most sense+when understood in the context of its parent.++For example, in the program+\begin{code} +abs x | x < 0 = -x+      | otherwise = x ++main = print (abs 42)+\end{code}+the parent of the result value \texttt{42} is+\begin{code}+abs 42 | False | True+\end{code}+This redex display states that the second branch in the definition of+\texttt{abs} was taken. The last guard was evaluated to \texttt{True}+whereas the previous guard was evaluated to \texttt{False}. You may+ask for the parent of \texttt{False} and learn that it was created+by the redex \texttt{42 < 0}.++\paragraph{Trusting}++Section \ref{trusting} describes trusting of modules as a means to+obtain a smaller trace.++In general the result of a trusted function may be an unevaluated+expression from within the trusted function. Such an expression is+shown with the symbol \texttt{\{?\}}. It cannot be expanded like a+dark box representing a cutoff expression, but it does have a parent.+For example, for the program++\begin{code}+main = print (take 5 (from 1))+\end{code}  +the parent of the result value \texttt{[1,2,3,4,5]} is+\begin{code}+take 5 (1:2:3:4:5:\{?\})+\end{code}+The parent of \texttt{\{?\}} is \texttt{from 1}, as for the whole expression+\texttt{(1:2:3:4:5:\{?\})}.++\paragraph{Unevaluated expressions}++Unevaluated expressions are shown by default with the underscore+symbol (\texttt{\_}).  Show you wish to see these expressions in+full, you should switch on the ``show-me-unevaluated-expressions''+option with the command \com{:set uneval on}.++++\subsubsection{Pattern bindings}++A program equation with a single variable or a pattern with variables+on the left hand side is a pattern binding. The parent of a variable+defined by a pattern binding is not the redex that called it, but+the redex on whose right-hand-side the pattern binding occurs. Hence+variables defined by top-level pattern bindings (i.e. constants)+do not have parents.++So usually the parent of an expression is the function call that+would have led to the evaluation of the expression if eager evaluation+were used.  However, this relation breaks down for pattern bindings.+++%--- got to here --------------------------------------------------------------++\subsection{Advanced Exploration of a Trace}++%You can gain a lot of information by just moving the selection+%over expressions in the trail pane. Expressions that are related to+%the currently-selected expression are highlighted in various ways.+%+%\subsubsection{Parents that are already shown}+%+%Many expressions have the same parent. Showing the same parent+%twice leads to unnecessary clutter in the trace pane. Hence, if the+%parent of the currently-selected expression is on display, then it+%is high-lighted with a \emph{yellow background} colour. This gives+%you a signal that it is unnecessary to demand the parent.+%+%\subsubsection{Siblings}+%+%As just stated many expressions have the same parent. To show you+%which expressions have the same parent as the currently-selected+%expressions, these expressions are displayed in \emph{blue} colour+%instead of the normal black colour.++\subsubsection{Shared expressions}++When you select a subexpression in the trail pane, sometimes not+only this expression is highlighted but also some other occurrences+of the subexpression.  The reason is that the marked occurrences are+shared. That is, they are not just equal, but they actually share+the same space in memory.  This operational observation can often+help you to understand a computation.++%\subsubsection{Shared expressions with different parents}++%It is possible that an occurrences of an expression is the same as the currently-selected expression, but has a different parent nonetheless. Such occurrences are not surrounded by a red box, but are displayed in \emph{green} colour.++%For example, for the program+%\begin{code}+%main = print (head [True, False])+%\end{code}+%the parent of the result value \texttt{True} is the redex+%\texttt{head [True, False]}. The result value \texttt{True} is the same as the first element of the list, the values are shared. However, the parent of the \%texttt{True} in the list is \texttt{main}, whereas the parent of the result is \texttt{head [True, False]}.+++%------------------------------------------------------------------------------++\subsection{Invoking other Viewing Tools}++It is possible to invoke hat-observe and hat-detect immediately+from hat-trail.++\begin{itemize}+\item The command \com{:observe} launches a new window with the+hat-observe tool, which immediately searches for all applications of+the currently selected function throughout the computation.+\item The command \com{:location} launches a new window with the+hat-observe tool, which immediately searches for applications of the+currently selected function, but only at the same source location as+the current selection.  This is useful to narrow down your exploration+to a specific site of interest.+\item The command \com{:detect} launches a new window with the+hat-detect tool, restricting the debugging algorithm solely to the+currently selected equation and all its dependents.+\item The command \com{:trail} starts a new window with a fresh+instance of the hat-trail tool starting with the current selection.+This can be useful if there are several redex trails you wish to+explore and compare side-by-side.+\end{itemize}++%------------------------------------------------------------------------------++\subsection{Some practical advice}++\begin{itemize}+\item First-time users of hat-trail tend to quickly unfold large parts+of the trace and thus clutter the screen and get lost. Think well,+before you demand to see another parent. It is seldom useful to follow+a long sequence of parents for whole redexes. Do not forget that you+can ask for the parent of any subexpression. Choose the subexpression+that interests you carefully. When locating an error, a wrong+subexpression of an argument is a good candidate for further enquiry.++In our experience usually less than 10 parents need to be viewed to+locate an error, even in large programs.++\item Use the links to the source as described in Section~\ref{source}.+The trail display is designed to be concise, so the source viewer gives+valuable context information.++%\item Use the various forms of highlighting described in+%Section~\ref{advanced}. The information conveyed by highlighting+%often makes viewing a parent superfluous.++\item Avoid $\lambda$-abstractions in your program. Informative+function names are very helpful for tracing.++\end{itemize}+++%------------------------------------------------------------------------------++\newpage+\subsection{Quick reference to commands}\label{trailquickref}++All the commands that are available in hat-trail are summarised in+the following table.++\begin{verbatim}+----------------------------------------------------------------------------+ cursor keys   movement within current expression+ [ and ] keys  movement within current expression+ RETURN        show parent expression of selected expression+ =             show final result of the whole expression line+ BACKSPACE     remove most recently-added expression/equation+ -/+           shrink/expand a cutoff expression+ ^L            repaint the display if it gets corrupted+ ^R            repaint the display after resizing the window+ :source       look at the source-code application of this expression+ :Source       look at the source-code definition of current function+ :observe      use hat-observe to find all applications of this function+ :location     use hat-observe to find all applications at this call site+ :trail        start a fresh hat-trail with the current expression+ :detect       use hat-detect to debug the current expression+ :set          show all current mode settings+ :set <flag>   change one mode setting+ :set <flag>   change one mode setting+   <flag> can be: uneval [on|off]      show unevaluated expressions in full+                  strSugar [on|off]    sugar character strings+                  listSugar [on|off]   sugar lists with [,,,] +                  equations [on|off]   show equations, not just redexes+                  cutoff <n>           cut-off depth for deeply nested exprs+ :+[n]         shortcut to increase cutoff depth+ :-[n]         shortcut to decrease cutoff depth+ :help  :?     show this help text+ :quit         quit+----------------------------------------------------------------------------+\end{verbatim}+++%==============================================================================++\section{Hat-Detect}\label{hat-detect}++Hat-detect is an interactive tool that enables you to locate+semi-automatically an error in a program by answering a sequence+of yes/no questions.  Each question concerns a reduction.  You have+to answer \emph{yes}, if the reduction is correct with respect to+your intentions, and \emph{no} otherwise.  After a number of questions+hat-detect states which reduction is the cause of the observed faulty+behaviour -- that is, which function definition is incorrect.++%\subsection{Limitations}\label{ioproblem}++%At the moment hat-detect does not handle IO actions properly. It+%can only handle computations that perform a \emph{single} primitive+%\emph{output} action such as \texttt{putStr} or \texttt{print}. Monadic+%binding operators (or do-notation) and input actions such as+%\texttt{read} lead to confusion.++%Hence the recommended usage of hat-detect is to first use hat-observe+%to locate an erroneous reduction that does not involve IO and+%then to invoke hat-detect for this reduction as described in+%Section~\ref{othersFromObserve}.++%Also, currently hat-detect can only be used for computations that+%produce faulty output, not for computations that abort with an error+%message or are interrupted (in the latter cases hat-detect may indicate+%a wrong error location).++\subsection{Starting \& Exiting}++Start hat-detect by entering+\begin{quote}+\texttt{hat-detect}~\emph{prog}\texttt{[.hat]}+\end{quote}+where \emph{prog} is the name of the traced program.++To exit hat-detect enter \texttt{:quit} or \texttt{:q}.++\subsection{The Help Menu}++Enter \texttt{:help} to obtain a short overview of the commands+understood by hat-detect.++\subsection{Basic Functionality}++Consider the following program:+\begin{quote}+\begin{alltt}+main = print (insSort "abc" ++ insSort "bca")++insSort :: Ord a => [a] -> [a]+insSort [] = []+insSort (x:xs) = insert x (insSort xs)++insert :: Ord a => a -> [a] -> [a]+insert x [] = [x]+insert x (y:ys)+  | x <= y    = x:y:ys+  | otherwise = (insert x ys)+\end{alltt}+\end{quote}++It produces the faulty output \texttt{"abcbc"} instead of the intended+output \texttt{"abcabc"}.++The following is an example session with hat-detect for the+computation. The \emph{y}/\emph{n} answers are given by the user:++\begin{quote}+\begin{alltt}+insSort "abc" == "abc"?+\emph{y}+insSort "bca" == "bc"?+\emph{n}+insert 'b' "c" == "bc"?+\emph{y}+insSort "ca" == "c"?+\emph{n}+insert 'c' "a" == "c"?+\emph{n}+insert 'c' [] == "c"?+\emph{y}+Bug Identified:+  "insSort.hs":8-11:+  insert x [] = [x]+  insert x (y:ys)+    | x <= y    = x:y:ys+    | otherwise = (insert x ys)+\end{alltt}+\end{quote}++The first question of the session asks if the reduction of \texttt{sort "abc"}+is correct. Hat-detect indicates that \texttt{sort "abc"} is reduced to+\texttt{"abc"}. The answer is obviously \emph{yes}.  Further answers from the+user show that the third and sixth reductions are correct, whereas the second,+fourth, and fifth are not.++After the answer to the sixth question hat-detect can determine+the location of the error.  The equation that is used to reduce+the redex \texttt{insert 'c' "a")} is wrong. Indeed, on the right-hand+side of the guard \texttt{otherwise}the result+should be \texttt{y~:~(insert~x~ys)}.++%\subsubsection{Postponing an Answer}++%If you are not sure about the answer to a question you can answer+%\emph{?n} or \emph{?y}.  If you answer \emph{?n}, then hat-detect+%proceeds as if the answer had been \emph{no}.  But if it cannot+%locate an error in one of the child reductions, then it will later+%ask you the question again.  Answering \emph{?y} will postpone the+%question as well, but hat-detect will proceed as if the answer hat+%been \emph{yes}. If it cannot locate an error in one of its brother+%reductions, then it will ask you the question again.++\subsubsection{Unevaluated Subexpressions}++Reductions may contain underscores \texttt{\_} that represent+unevaluated subexpressions.  A question with an underscore on the+left-hand side of the reduction has to be read as ``is the reduction+correct for \emph{any} value at this position?'' and a question+with an underscore on the right-hand side should be read as ``is the+reduction correct for \emph{some} value at this position?''.  If there+are several underscores in a reduction the values at these positions+need not be the same.++\subsection{Algorithmic Debugging}++Hat-detect is based on the idea of algorithmic/declarative+debugging. The reductions of a computation are related by a tree+structure. The reduction of \texttt{main} is the root of the tree. The+children of a reduction of a function application are all those+reductions that reduce expressions occurring on the right-hand side+of the definition of the function.++If a question about a reduction is answered with \emph{no}, then+the next question concerns the reduction of a child node. However,+if the answer is \emph{yes}, then the next question will be about a+sibling or a remaining node closer to the root.++An error is located when a node is found such that its reduction is+incorrect but the reductions of all its children are correct. That+reduction is the source of the error.++\subsection{Advanced Features}++\subsubsection{Single stepping}++Hat-detect can be used rather similarly to a conventional debugger.+So the input \emph{no} means ``step into current function call''+and the input \emph{yes} means ``go on to next function call''. Note+that this single stepping is not with respect to the lazy evaluation+order actually used in the computation, but with respect to an eager+evaluation order that ``magically'' skips over the evaluation of+expressions that are not needed in the remaining computation.++%\subsubsection{Showing unevaluated subexpressions}++%By default hat-detect shows unevaluated subexpressions just as+%underscores \texttt{\_}. For answering a question these unevaluated+%subexpressions are irrelevant anyway. However, by entering the+%\texttt{:set verbose on} command you can switch to verbose mode+%which shows these unevaluated subexpressions in full.  Use+%\texttt{:set verbose off} to switch the verbose mode off again.++%\subsubsection{Going back to a question}++%The questions are numbered. By entering a number \emph{n} you can+%go back to any previous question numbered \emph{n}.  When you do this,+%the answers to all intervening questions are deleted.++%\subsubsection{Trusting}++%Hat-detect does not ask any question about the reductions of functions+%that are trusted as described in Section~\ref{trusting}.  However, you+%can trust further functions and thus avoid questions about them.  By+%entering \texttt{:trust} instead of \texttt{y} when being asked about a+%specific reduction of a function you trust this function.  By entering+%\texttt{:untrust} you stop trusting \emph{all} these functions again.++%\subsubsection{Memoisation}++%By default hat-detect memoises all answers you gave.  So, although+%the same reduction may be performed several times in a computation,+%hat-detect will only ask once about it.  Hat-detect even avoids asking+%a question, if a more general question (containing more unevaluated+%expressions) has been answered before.++%You can turn memoisation on/off with the command \texttt{:set memoize on}+%or \texttt{:set memoize off}.++\subsubsection{Invoking other Viewing Tools}++%\paragraph{Observing a function}++%When being asked about a specific reduction of a function you can enter+%\texttt{:observe} to observe the function.  The hat-observe tool will+%appear in a new window, showing all applications of the given function.+%This interface to hat-observe is particularly useful, if you are+%not sure whether to trust a function for Algorithmic Debugging. By+%observing all applications of the function you can decide whether+%the function can indeed be trusted or not.  If you find an erroneous+%reduction in the observation, you can select it and in turn start a+%new Algorithmic Debugging session for this reduction.++\paragraph{Tracing arguments}++When \texttt{hat-detect} asks you about the reduction of an+application, which obviously has a \emph{wrong} argument, you should+consider using \texttt{hat-trail} to investigate where this argument+came from.  By answering a question with \texttt{:trail} the Redex+Trail browser is launched immediately from the Algorithmic Debugger.++\subsection{Quick reference to commands}++All the commands that are available in hat-detect are summarised in+the following table.++\begin{verbatim}+------------------------------------------------------------------------+ y   or  yes  you believe the equation is ok+ n   or  no   you believe the equation is wrong++ :show        Show the EDTs that hat-detect is currently investigating.+ :children    Show the children of the current reduction.++ :help        show help text+ :quit        quit++ :anim        start hat-anim on the current function+ :detect or   start hat-detect (in a new window) on the current+ :split       function+ :delta       start hat-delta on the current function+ :explore     start hat-explore on the current function+ :trail       start hat-trail on the current equation+------------------------------------------------------------------------+\end{verbatim}+% ?y  or  y?       you are not sure (but try ok for now)+% ?n  or  n?       you are not sure (but try wrong for now)+% <n>              go back to question <n>+% :set             show all current mode settings+% :set <flag>      change one mode setting+%      <flag> can be: memoise [on|off]:  never ask the same question again+%                     verbose [on|off]:  show unevaluated exprs in full+%                     cutoff <n>:        set subexpression cutoff depth+% :trust           trust all applications of the current function+% :untrust         untrust ALL functions which were previously trusted++%==============================================================================++\section{Hat-Delta}++Hat-delta is an interactive tool that enables you to locate+semi-automatically an error in a program by answering a sequence+of yes/no questions.  The tool works in a very similar way to hat-detect, but+is more intelligent in it's choice of questions.  This usually results in+shorter debugging sessions.++\subsection{Starting \& Exiting}++Start hat-delta by entering+\begin{quote}+\texttt{hat-delta}~\emph{prog}\texttt{[.hat]}+\end{quote}+where \emph{prog} is the name of the traced program.++To exit hat-delta enter \texttt{:quit} or \texttt{:q}.++\subsection{The Help Menu}++Enter \texttt{:help} to obtain a short overview of the commands+understood by hat-delta.++\subsection{Basic Functionality}++Consider the following program:+\begin{quote}+\begin{alltt}+main = print (insSort "abc" ++ insSort "bca")++insSort :: Ord a => [a] -> [a]+insSort [] = []+insSort (x:xs) = insert x (insSort xs)++insert :: Ord a => a -> [a] -> [a]+insert x [] = [x]+insert x (y:ys)+  | x <= y    = x:y:ys+  | otherwise = (insert x ys)+\end{alltt}+\end{quote}++It produces the faulty output \texttt{"abcbc"} instead of the intended+output \texttt{"abcabc"}.++The following is an example session with hat-delta for the+computation. The \emph{y}/\emph{n} answers are given by the user:++\begin{quote}+\begin{alltt}+insSort "abc" == "abc"?+\emph{y}+insert 'c' "a" == "c"?+\emph{n}+Bug Identified:+  "insSort.hs":8-11:+  insert x [] = [x]+  insert x (y:ys)+    | x <= y    = x:y:ys+    | otherwise = (insert x ys)+\end{alltt}+\end{quote}++The first question of the session asks if the reduction of \texttt{sort "abc"}+is correct. Hat-detect indicates that \texttt{sort "abc"} is reduced to+\texttt{"abc"}. The answer is obviously \emph{yes}.  The second question asks about \texttt{insert 'c' "a"}, and receives a \emph{no} answer.++After the answer to the second question hat-delta can determine+the location of the error.  The equation that is used to reduce+the redex \texttt{insert 'c' "a")} is wrong. Indeed, on the right-hand+side of the guard \texttt{otherwise}the result+should be \texttt{y~:~(insert~x~ys)}.++\subsection{Delta Debugging}++Hat-delta is based on the idea of algorithmic delta debugging.  The process is+similar to that of algorithmic debugging.  However the process varies in the+algorithm used to identify which question to ask next.++Delta debugging calculates a likelihood of a question getting a no answer by+looking at how often a section of program code has been executed before.++The process is then more likely to ask questions about these nodes.++\subsection{Quick reference to commands}++All the commands that are available in hat-detect are summarised in+the following table.++\begin{verbatim}+------------------------------------------------------------------------+ y   or  yes  you believe the equation is ok+ n   or  no   you believe the equation is wrong++ :show        Show the EDTs that hat-detect is currently investigating.++ :help        show help text+ :quit        quit++ :anim        start hat-anim on the current function+ :detect      start hat-detect on the current function+ :delta or    start hat-delta (in a new window) on the current+ :split       function+ :explore     start hat-explore on the current function+ :trail       start hat-trail on the current equation+------------------------------------------------------------------------+\end{verbatim}++\section{Hat-Stack}++For aborted computations, that is computations that terminated with an error message or were interrupted, hat-stack shows in which function call the computation was aborted. It does so by showing a \emph{virtual} stack of function calls (redexes). So every function call on the stack caused the function call above it. The evaluation of the top stack element caused the error or during its evaluation the computation was interrupted. The shown stack is \emph{virtual}, because it does not correspond to the actual runtime stack. The actual runtime stack enables lazy evaluation whereas the \emph{virtual} stack corresponds to a stack that would be used for eager (strict) evaluation.++\subsection{Usage}++To use hat-stack enter+\begin{quote}+\texttt{hat-stack}~\emph{programname}+\end{quote}+where \emph{programname} is the name of the traced program.++\subsection{Example}++Here is an example output:+\begin{alltt}+Program terminated with error:+    "No match in pattern."+Virtual stack trace:+    (last' [])                     (Example.hs: line-6/col-16)+    (last' (5+6:[]))               (Example.hs: line-6/col-16)+    (last' ((div 5 0):5+6:[]))     (Example.hs: line-6/col-16)+    (last' (8:(div 5 0):5+6:[]))   (Example.hs: line-4/col-27)+    main                           (Example.hs: line-2/col-1)+\end{alltt}++\subsection{Further Information}++Hat-trail can also show this virtual stack. Hat-stack is a simple+tool that enables you to obtain the stack directly.  The description+of hat-trail contains more details about the relationships between+the stack elements.++%Hat-stack shows $\dashedBox$+%(see Section~\ref{trailtrusting}) and subexpressions of very large+%expressions as a dot ($\cdot$).+++%==============================================================================++\newpage+\section{Limitations of Functionality}++Although Hat can trace nearly any Haskell 98 program, some program+constructs are still only supported in a restricted way. See the Hat+web page for further limitations and bugs.++\subsection{List Comprehensions}++List comprehensions are desugared by Hat, that is, their implementation+in terms of higher-order list functions such as \texttt{foldr}+is traced.++\subsection{Labelled Fields (records)}++Expressions with field labels (records) are desugared by Hat. So+viewing tools show field names only as selectors but never together+with the arguments of a data constructor. An update using field labels+is shown as a \texttt{case} expression.++\subsection{Strictness Flags}++Strictness flags in data type definitions are ignored by Hat and+hence lose their effect.++%==============================================================================++\end{document}+%------------------------------------------------------------------------------+% End+
+ docs/hw01-draft.ps.gz view

binary file changed (absent → 107129 bytes)

+ docs/ifl2002.ps.gz view

binary file changed (absent → 84213 bytes)

+ docs/index.html view
@@ -0,0 +1,378 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<html>++<head><title>Hat - the Haskell Tracer</title></head>+<body text="#000000" bgcolor="#FFFFFF" link="#0000EE" vlink="#551A8B"+      alink="#FF0000">++<center>+  <img src="hat.gif" alt="Hat Logo">+  <h1>Hat - the Haskell Tracer</h1>+</center>+<hr>++<table><tr>+<td width="50%" valign="top">+<p>+<center><b>about</b></center>+<dl>+<dd><a href="#intro">What is Hat?</a></dd>+<dd><a href="#tools">How do I view a trace?</a></dd>+<dd><a href="feature-table.html">Coverage of Haskell 98 + extensions</a></dd>+<dd><a href="bugs.html">Known bugs</a></dd>+<dd><a href="libraries.html">Libraries supported by <b>Hat</b></a></dd>+<dd><a href="faq.html">Frequently asked questions</a></dd>+<dd><a href="copyright.html">Copyright and licence information</a></dd>+</dl>++</td><td width="50%" valign="top">++<p>+<center><b>download/build/install</b></center>+<dl>+<dd><!--img src="new_tiny.gif" alt="new"-->+    Version 2.06 released 2nd Oct 2008.</dd>+<dd><a href="download.html">Download <b>Hat</b></a></dd>+<dd><a href="requirements.html">System requirements</a></dd>+<dd><a href="install.html">Build and install instructions</a></dd>+<dd><a href="config.html">Configuration options</a></dd>+<dd><a href="status.html">Recent changes</a></dd>+</dl>++</td></tr><tr><td width="50%" valign="top">++<p>+<center><b>user guides</b></center>+<dl>+<dd>A simple tutorial introduction:<br>+    &nbsp;&nbsp;+    <a href="tutorial1.html">(HTML)</a>+    <a href="tutorial1.tex">(TeX)</a>+    <a href="tutorial1.ps">(PostScript)</a>+    <a href="tutorial1.pdf">(PDF)</a>+    </dd>+<dd>The Hat user manual:<br>+    &nbsp;&nbsp;+    <a href="hatuser.html">(HTML)</a>+    <a href="hatuser.tex">(TeX)</a>+    <a href="hatuser.ps">(PostScript)</a>+    <a href="hatuser.pdf">(PDF)</a>+    </dd>+<dd>hat-explore user manual: <img src="new_tiny.gif" alt="new"><br>+    &nbsp;&nbsp;+    <a href="hatexploreuser.html">(HTML)</a>+    <a href="hatexploreuser.tex">(TeX)</a>+    <a href="hatexploreuser.ps">(PostScript)</a>+    <a href="hatexploreuser.pdf">(PDF)</a>+    </dd>+<dd><a href="hat-trans.html">Reference Guide (hat-trans)</a></dd>+<dd>Unix man pages:<!-- img src="new_tiny.gif" alt="new" --><br>+    &nbsp;&nbsp;+    <a href="hat-trans.1.html">hat-trans</a>+    <a href="hat-observe.1.html">hat-observe</a>+    <a href="hat-trail.1.html">hat-trail</a><br>+    &nbsp;&nbsp;+    <a href="hat-stack.1.html">hat-stack</a>+    <img src="new_tiny.gif" alt="new">+    <a href="hat-delta.1.html">hat-delta</a><br>+    &nbsp;&nbsp;+    <img src="new_tiny.gif" alt="new">+    <a href="hat-detect.1.html">hat-detect</a>+    <a href="hat-cover.1.html">hat-cover</a><br>+    &nbsp;&nbsp;+    <img src="new_tiny.gif" alt="new">+    <a href="hat-anim.1.html">hat-anim</a>+    <a href="black-hat.1.html">black-hat</a><br>+    &nbsp;&nbsp;+    <a href="hat-nonterm.1.html">hat-nonterm</a>+    <img src="new_tiny.gif" alt="new">+    <a href="pretty-hat.1.html">pretty-hat</a>+    </dd>+</dl>++</td><td width="50%" valign="top">++<p>+<center><b>development</b></center>+<dl>+<dd><a href="news.html">Project news</a></dd>+<dd><a href="publications.html">Technical publications</a></dd>+<dd><a href="bugs.html">Known bugs</a></dd>+<dd><a href="todo.html">Wish list</a></dd>+<dd><a href="darcs.html">darcs repository</a></dd>+<dd><a href="http://www.cs.york.ac.uk/fp/hat/Memos">Internal developer memos</a></dd>+</dl>++<p>+<center><b>community</b></center>+<dl>+<dd><a href="maillist.html">+    Mailing list for everything <b>Hat</b>-related</a></dd>+<dd><a href="http://haskell.org/mailman/listinfo">+    More general Haskell mailing lists</a></dd>+<dd><a href="http://www.haskell.org/">+    Other Haskell systems and resources</a></dd>+</dl>++</td></tr><tr><td width="50%" valign="top">++</td><td width="50%" valign="top">++</td></tr></table>++<p align="center">+<font size="1">+Development of Hat was funded by grant number GR/M81953 from the Engineering+and Physical Sciences Research Council of the United Kingdom.+</font>++<hr>++<h2><a name="intro">What is Hat?</a></h2>+<p>+<b>Hat</b> is a source-level tracer for +<a href="http://www.haskell.org/"><em>Haskell 98</em></a>, the+standard lazy functional programming language.  Hat is a tool that+gives the user access to otherwise invisible information about a+computation.++<p>+<b>Hat</b> is portable between compilers: it works with both+<em>ghc</em> and <em>nhc98</em>.  It also supports various language+extensions, such as the FFI, multi-parameter type classes, functional+dependencies, and hierarchical module namespaces.++<h3>What is it good for?</h3>+<p>+Hat helps locating errors in programs.  Furthermore, it is useful for+understanding how a (correct) program works, especially for teaching+and program maintenance.  Hat is <em>not</em> a time or space profiler.+Hat can be used for programs that terminate normally, that terminate+with an error message or that terminate when interrupted by the+programmer.++<h3>How does it work?</h3>+<p>+Tracing a program with Hat consists of two phases: First the specially+compiled program runs as normal, except that additionally a trace is+written to file. Second, after the program has terminated, the trace+is viewed with a browsing tool.+The trace consists of high-level information about the computation. It+describes each reduction, that is, the replacements of an instance+of a left-hand side of an equation by an instance of its right-hand+side, and the relation of the reduction to other reductions.+Because the trace describes the whole computation, it is huge. Hat+comes with several tools to selectively view the fragments of the trace+that are of interest. Each tool shows fragments of the computation+in a particular way, highlighting a specific aspect.++<h2><a name="tools">How can I view a trace?</a></h2>++Because the trace describes the whole computation, it is huge. Hat+comes with several tools to selectively view the fragments of the trace+that are of interest. Each tool shows fragments of the computation+in a particular way, highlighting a specific aspect.++<p>+All tools show function arguments in evaluated form, more precisely: as+far evaluated as the arguments are at the end of the computation. For+example, although in a computation the unevaluated expression <kbd>(map+(+5) [1,2])</kbd> might be passed to the function <kbd>length</kbd>,+the tools will show the function application as <kbd>length+[1+5,2+5]</kbd> or <kbd>length [_,_]</kbd>.++<p>+For example, the computation of the faulty program+<pre>+main = let xs :: [Int]+           xs = [4*2,5 `div` 0,5+6]+       in  print (head xs,last' xs)++last' (x:xs) = last' xs+last' [x] = x+</pre>++gives the result+<pre>+(8, No match in pattern.+</pre>+and the Hat viewing tools can be used to explore its behaviour as follows:++<ul>++<li><strong>Hat-observe</strong> (inspired by <a+href="http://haskell.org/hood">Hood</a>) <br>++Hat-observe is an interactive tool that shows how top-level functions+are used.  That is, for a given top-level function name it shows+all the arguments with which it is called during the computation,+together with the respective results.++<pre>+$ hat-observe Example++                hat-observe 2.04    (:h for help, :q to quit)++hat-observe&gt; main+<font color=blue>1</font>  main = IO (print (8,_|_))+hat-observe&gt; print+<font color=blue>1</font>  print (8,_|_) = IO (print (8,_|_))+hat-observe&gt; last'+<font color=blue>1</font>  last' [8,_,_] = _|_+<font color=blue>2</font>  last' [_,_] = _|_+<font color=blue>3</font>  last' [_] = _|_+<font color=blue>4</font>  last' [] = _|_+hat-observe&gt; :quit+$+</pre>+<p>++<li><strong>Hat-trail</strong><br>++Hat-trail is an interactive tool that enables exploring a computation+<em>backwards</em>, starting at the program output or an error message+(with which the computation aborted).  This is particularly useful+for locating an error.  You start at the observed faulty behaviour+and work backwards towards the source of the error.++<p>+Every reduction replaces an instance of the left-hand side of a program+equation by an instance of its right-hand side. The instance of the+left-hand side ``creates'' the instance of the right-hand side and is+therefore called its <em>parent</em>. With hat-trail you can obtain+the parent of any expression.++<p>+(Note: if you cannot see any highlighting in the following diagram,+try changing the fixed-width font in your browser to something like+Courier text.)  Each line of the trail is the parent of the highlighted+subexpression directly above it.++<pre>+<strong>Error: -------------------------------------------------------</strong>+<font color=red>No match in pattern.</font>+<strong>Output: ------------------------------------------------------</strong>+(8,+<strong>Trail: ---------------------- </strong>Example.hs line: 2 col: 12<strong> -----</strong>+&lt;- <font color=red>last' []</font>+&lt;- <font color=red>last' [_]</font>+&lt;- <font color=red>last' [_,_]</font>+&lt;- last' [<font color=red>8</font>,_,_]+&lt;- <font color=red>4 * 2</font>+&lt;- <strong><font color=magenta>xs</font></strong>+</pre>+<p>+Here, the error message is chosen as the starting point, rather+than any of the output.  The first trail is therefore+<kbd>last' []</kbd>, because its evaluation caused the error message.+The parent of <kbd>last' []</kbd> is+<kbd>last' [_]</kbd>.  The parent of <kbd>last' [_]</kbd>+is <kbd>last' [_,_])</kbd>, etc. The parent of the+subexpression <kbd>8</kbd> is <kbd>4*2</kbd> whose parent is+<kbd>xs</kbd>.+<p>+++<li><strong>Hat-explore</strong><br>+Hat-explore allows you to step through a computation. Like a conventional debugger hat-explore highlights your current position in the computation in the program source and shows a stack backtrace of function calls. In contrast to conventional debuggers you are free of the actual evaluation order when stepping through the computation. From any function call you can go down to any further function called by it, to a function call in the same function definition, or upwards to the caller of the current function call. +<p>+Because arguments and the result are shown for each function call, it is easier to determine which function is incorrect. You can also mark reductions as correct/incorrect which enables the tool to pinpoint the bug to a smaller and smaller slice of the program.++<pre>+<strong>==== Hat-Explore 2.04 ==== Press h for help. ===================</strong>+ 1. <font color=blue>main = {IO}</font>+ 2. <font color=blue>last' [8,_,_] = _|_</font>+ 3. <font color=blue>last' [_,_] = _|_</font>+ 4. <font color=blue>last' [_] = _|_</font>+ 5. <font color=blue>last' [] = _|_</font>+<strong>---- Last.hs ---- lines 1 to 7 ---------------------------------</strong>++main = let xs :: [Int]+           xs = [4*2,5 `div` 0,5+6]+       in  print (head xs,last' xs)++last' (x:xs) = <font color=blue>last' xs</font>+last' [x] = x+</pre>++<li><strong>Hat-detect</strong> (inspired by <a+href="http://www.ida.liu.se/~henni/">Freja</a>) <br>+Hat-detect is an interactive tool that enables the semi-automatic+location of an error in a program by answering a sequence of yes/no+questions.  Each question asked by hat-detect concerns the reduction+of a redex - that is, a function application - to a value.  You have to+answer <em>yes</em>, if the reduction is correct with respect to your+intentions, and <em>no</em> otherwise.  After a number of questions+hat-detect states which reduction is the cause of the observed faulty+behaviour - that is, which function definition is incorrect.++<p>+Example session (y/n answers are given by the user):+<pre>+$ hat-detect Example++                hat-detect 2.0x    (:h for help, :q to quit)++<font color=blue>1</font>  main = IO (print [3,3,3])   ? n+<font color=blue>2</font>  sort [3,2,1] = [3,3,3]   ? n+<font color=blue>3</font>  insert 1 [] = [1]     ? y+<font color=blue>4</font>  insert 2 [1] = [2,2]     ? n+<font color=blue>5</font>  insert 2 [] = [2]     ? y++Error located!+Bug found in reduction:   insert 2 [1] = [2,2]+</pre>+<p>++<li><strong>Hat-stack</strong><br>++For aborted computations, that is computations that terminated+with an error message or were interrupted, hat-stack shows in which+function call the computation was aborted.  It does so by showing a+<em>virtual</em> stack of function calls (redexes).  Thus, every function+call shown on the stack caused the function call above it. The evaluation+of the top stack element caused the error (or during its evaluation+the computation was interrupted).  The stack shown is <em>virtual</em>,+because it does not correspond to the actual runtime stack.  The actual+runtime stack enables lazy evaluation whereas the <em>virtual</em>+stack corresponds to a stack that would be used for eager (strict)+evaluation.++<p>+Using the same example program as above, hat-stack shows+<pre>+$ hat-stack Example+Program terminated with error:+        No match in pattern.+Virtual stack trace:+(Last.hs:6)     last' []+(Last.hs:6)     last' [_]+(Last.hs:6)     last' [_,_]+(Last.hs:4)     last' [8,_,_]+(unknown)       main+$+</pre>+<p>++</ul>+++<p>+If you have any problems, please send a message to the+mailing list at <a href="mailto:hat@haskell.org">hat@haskell.org</a>.++<hr>+<p>+The latest updates to these pages are available on the WWW from+<a href="http://haskell.org/hat/">+<tt>http://haskell.org/hat/</tt></a><br>+<a href="http://www.cs.york.ac.uk/fp/hat/">+<tt>http://www.cs.york.ac.uk/fp/hat/</tt></a>++<p>+This page last modified: 2nd Oct 2008<br>+<a href="http://www.cs.york.ac.uk/fp/">+York Functional Programming Group</a><br>++</body></html>+
+ docs/install.html view
@@ -0,0 +1,140 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<html><head><title>Building/installing hat</title></head>+<body bgcolor=#ffffff>+<table><tr><td width=500>++<center>+  <img src="hat.gif" alt="Hat Logo"><br>+  <h1>Building/installing hat</h1>+</center>++<hr>+<h3>The Brief Version</h3>+<p>+If you are in a hurry to get started, here's the brief version of the+install procedure:+<pre>+    $ ./configure  [ --prefix=/usr/local ]+    $ make+    [ perhaps become root ]+    $ make install+</pre>++<a href="requirements.html"><h3>System Requirements</h3></a>++<h3>Download it</h3>+<p>+The current distribution packages can be found at+<pre>+    <a href="http://www.haskell.org/hat/download.html">http://www.haskell.org/hat/download.html</a>+</pre>+Using <em>tar</em> and <em>gunzip</em>, unpack your chosen package, and+<em>cd</em> to the base directory (called hat-x.xx, where the x's are the+version number).  Note that all the documentation available on the web+is also included in the package, although the web versions will of course+be more up-to-date.  Your local copy of the release notes is+in <a href="status.html">status.html</a>.++<h3>Configuration</h3>+<p>+An automatic configuration utility is supplied, called+<em>configure</em>.  The configure script searches your system+for Haskell compilers and sets up some scripts and options before+you build.  In brief, the default behaviour is to build under+<em>targets</em> in the current directory, and to install various+components under <em>/usr/local</em>, in the subdirectories+<em>bin</em>, <em>lib/hat</em>, <em>include/hat</em>, and+<em>man/man1</em>.  Some components will also be installed eventually+in the system directories for ghc or nhc98, whichever compiler is+available.  Nothing is actually installed at configuration time,+only at installation time.  The config script has several useful+options to override the default build and installation behaviours.+Use the <em>--help</em> option for brief details, and see the page+about <a href=config.html>configuration options</a> for full details.+++<h3>Building and installing from sources</h3>+<p>+All object files are created in a separate directory tree from the+sources (targets/$MACHINE/obj).  This means in theory it is possible+to build concurrently for different machines from the same shared+source tree.  (But we haven't tested that recently.)++<p>+Run <em>./configure</em> with any <a href=config.html>options</a> you+require.  (You should supply installation directory options at this+stage.)  This will attempt to detect any existing Haskell compilers and+guess which one to build <em>hat</em> with.  If you have more than one+available, we will choose, in order of preference, <em>ghc</em>, then+<em>nhc98</em>.  You cannot currently build or use hat with <em>hugs</em>,+<em>hbc</em>, or <em>Helium</em>.++<p>+Then just run <em>make</em> to build all the components.  (The target+<em>make help</em> gives a list of individual targets, if you really+want to build components individually.)++<p>+The time taken to build Hat depends on your machine and which compiler+you are using.  Here are some sample build times in minutes:++<center>+<table border=1><tr>+    <th></th>+    <th colspan=2>time (mins)</th>+</tr><tr>+    <th>build<br>compiler</th>+    <th>Linux<br>i686 (500Mhz)</th>+    <th>Linux<br>i686 (1Ghz)</th>+    <th>Linux<br>i686 (2.4Ghz)</th>+</tr><tr>+    <td>ghc</td>+    <td align=right>22</td>+    <td align=right>17</td>+    <td align=right>5</td>+</tr><tr>+    <td>nhc98</td>+    <td align=right>48</td>+    <td align=right>25</td>+    <td align=right>8</td>+</tr></table>+</center>++<p>+Finally, when you have built all the components you require, type+<em>make install</em> to copy the components to their final location.+(You may need to become root for this step, depending on the final+location you selected at configure time.  You must certainly have+permission to write package files into the system directories of the+compiler that was found at configuration time.)++<h3>Problems?</h3>+<p>+Ok, so now you should have all the components of hat.  If you+have any problems, mail <a href="mailto:hat@haskell.org">+<tt>hat@haskell.org</tt></a> with a description (and a bugfix if you+have one!).++<h3>Keeping up-to-date</h3>+<p>+If you use <em>hat</em> regularly, or if you would like to+use <em>hat</em> but for some reason cannot, please join the <a+href="maillist.html">hat mailing list</a> for discussion of features,+bugfixes, and so on.++<hr>+<p>+The latest updates to these pages are available on the WWW from+<a href="http://www.haskell.org/hat/">+<tt>http://www.haskell.org/hat/</tt></a><br>+<a href="http://www.cs.york.ac.uk/fp/hat/">+<tt>http://www.cs.york.ac.uk/fp/hat/</tt></a>++<p>+This page last modified: 27th July 2004<br>+<a href="http://www.cs.york.ac.uk/fp/">+York Functional Programming Group</a><br>++</td></tr></table>+</body></html>+
+ docs/libraries.html view
@@ -0,0 +1,191 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<html><head><title>Libraries in Hat</title></head>+<body bgcolor=#ffffff>+<table><tr><td width=500>++<center>+  <img src="hat.gif" alt="Hat Logo"><br>+  <h1>Libraries in Hat</h1>+</center>+<hr>++<h3>Standard Libraries</h3>+<p>+Currently, Hat fully supports the Standard Prelude and official+Haskell'98 libraries, defined in the +<a href="http://www.haskell.org/onlinelibrary/_._.html">+<em>Haskell '98 Library Report</em></a>:+++<h3>Extension Libraries</h3>+<p>+Hat also supports some of the extension libraries supplied with+more recent versions of GHC, nhc98, and Hugs.  These are the+<em>hierarchical libraries</em> mainly in the <em>base</em> package.+Actually only a subset of the base, parsec, and mtl packages is+currently available in Hat, but it includes most of the really+useful and common extensions, such as the FFI libraries, IORefs,+and unsafePerformIO.  A full list is below.++<table border=1 align=center cellspacing=0 cellpadding=2><tr>+<th><font color="green">supported</font></th>+<th><font color="red">unsupported</font></th>+</tr><tr>+<td valign=top>+    Control.Arrow<br>+    Control.Monad<br>+    Control.Monad.Cont<br>+    Control.Monad.Error<br>+    Control.Monad.Fix<br>+    Control.Monad.Identity<br>+    Control.Monad.List<br>+    Control.Monad.Reader<br>+    Control.Monad.RWS<br>+    Control.Monad.State<br>+    Control.Monad.Trans<br>+    Control.Monad.Writer</td>+<td valign=top>+        Control.Concurrent<br>+        Control.Concurrent.*<br>+        Control.Exception<br>+        Control.Exception.*<br>+        Control.Monad.ST<br>+        Control.Parallel<br>+        Control.Parallel.*</td>+</tr><tr>+<td valign=top>+    Data.Array<br>+    Data.Bits<br>+    Data.Bool<br>+    Data.Char<br>+    Data.Complex<br>+    Data.Either<br>+    Data.FiniteMap<br>+    Data.IORef<br>+    Data.Ix<br>+    Data.List<br>+    Data.Maybe<br>+    Data.Monoid<br>+    Data.PackedString<br>+    Data.Ratio<br>+    Data.Set<br>+    Data.Tuple<br>+    Data.Word</td>+<td valign=top>+        Data.Array.*<br>+        Data.Int<br>+        Data.Generics<br>+        Data.Dynamic<br>+        Data.STRef<br>+        Data.STRef.*<br>+        Data.Unique<br>+        Data.Word</td>+</tr><tr>+<td valign=top>+    Debug.Trace</td>+<td valign=top>+        Debug.QuickCheck<br>+        Debug.QuickCheck.*</td>+</tr><tr>+<td valign=top>+    Foreign.ForeignPtr<br>+    Foreign.Marshal.Error<br>+    Foreign.Ptr<br>+    Foreign.StablePtr<br>+    Foreign.Storable</td>+<td valign=top>+        Foreign.C<br>+        Foreign.C.Error<br>+        Foreign.C.String<br>+        Foreign.C.Types<br>+        Foreign.C.TypesISO<br>+        Foreign.Marshal.Alloc<br>+        Foreign.Marshal.Array<br>+        Foreign.Marshal.Utils<br>+        Foreign.Marshal.Pool</td>+</tr><tr>+<td valign=top>+    System.CPUTime<br>+    System.Console.GetOpt<br>+    System.Cmd<br>+    System.Directory<br>+    System.Environment<br>+    System.Exit<br>+    System.IO<br>+    System.IO.Error<br>+    System.IO.Unsafe<br>+    System.Locale<br>+    System.Random<br>+    System.Time</td>+<td valign=top>+        System.Info<br>+        System.Mem<br>+        System.Mem.StableName<br>+        System.Mem.Weak<br>+        System.Posix.Signals<br>+        System.Posix.Types</td>+</tr><tr>+<td valign=top>+    Text.ParserCombinators.Parsec<br>+    Text.ParserCombinators.Parsec.Error<br>+    Text.ParserCombinators.Parsec.Char<br>+    Text.ParserCombinators.Parsec.Combinator<br>+    Text.ParserCombinators.Parsec.Expr<br>+    Text.ParserCombinators.Parsec.Perm<br>+    Text.ParserCombinators.Parsec.Pos<br>+    Text.ParserCombinators.Parsec.Prim<br>+    Text.PrettyPrint<br>+    Text.PrettyPrint.HughesPJ<br>+    Text.Read<br>+    Text.Show</td>+<td valign=top>+        Text.Html<br>+        Text.Html.BlockTable<br>+        Text.ParserCombinators.Parsec.Language<br>+        Text.ParserCombinators.Parsec.Token<br>+        Text.ParserCombinators.ReadP<br>+        Text.ParserCombinators.ReadPrec<br>+        Text.Read.Lex<br>+        Text.Regex<br>+        Text.Regex.Posix<br>+        Text.Show.Functions</td>+</tr></table>+++<h3>Your Own Libraries</h3>+<p>+If you wish to trace a program that uses some libraries, then at the+moment you need to copy the source for that library into the same+source tree as your program, and explicitly compile it for tracing+along with the program.  Obviously this requires that the library+itself is implemented exclusively in the superset of Haskell'98+supported by Hat.  If you trust that the library is correct and do+not wish to trace its internal calls, then you can give the flag+<em>-trusted</em> to <em>hat-trans</em> (for that library alone).+++<h3>Future improvements</h3>+<p>+We have ideas for the future whereby a library can be used in+its original form without needing re-compilation for tracing.+We sometimes refer to this idea as <em>wrapping</em> a library, as+opposed to the current method of <em>lifting</em> the library source+code by transformation.  However, for the moment library-wrapping+remains a dream.++<hr>+<p>+The latest updates to these pages are available on the WWW from+<a href="http://www.haskell.org/hat/">+<tt>http://www.haskell.org/hat/</tt></a><br>+<a href="http://www.cs.york.ac.uk/fp/hat/">+<tt>http://www.cs.york.ac.uk/fp/hat/</tt></a>++<p>+This page last updated: 27th July 2004<br>+<a href="http://www.cs.york.ac.uk/fp/">+York Functional Programming Group</a><br>++</td></tr></table>+</body></html>+
+ docs/maillist.html view
@@ -0,0 +1,56 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<html><head><title>Hat mailing list</title></head>+<body bgcolor=#ffffff>+<table><tr><td width=500>++<center>+  <img src="hat.gif" alt="Hat Logo"><br>+  <h1>Hat mailing list</h1>+</center>++<hr>++<h3>List information</h3>+<p>+    The <em>Hat@haskell.org</em> mailing list is for all users,+    potential users, and developers of the <em>Hat</em> Haskell+    Tracing system.  Please use it for sending bug reports, bug fixes,+    and wishes, and also for discussion of tracing of functional+    computations in general, as well as the features of the Hat tracer+    in particular.++<h3>To subscribe or unsubscribe</h3>+<p>+To join or leave the list, or to search its archives, visit+<tt>+<a href="http://haskell.org/mailman/listinfo/hat">+  http://haskell.org/mailman/listinfo/hat</a>+</tt>++<h3>To post to the list</h3>+<p>+Messages intended for the whole list are sent to the address:+<tt>+    <a href="mailto:hat@haskell.org">hat@haskell.org</a>+</tt>+You do not need to be a member of the list to post to it.+++<p>+<hr>+<p>+The latest updates to these pages are available on the WWW from+<a href="http://www.haskell.org/hat/">+<tt>http://www.haskell.org/hat/</tt></a><br>+<a href="http://www.cs.york.ac.uk/fp/hat/">+<tt>http://www.cs.york.ac.uk/fp/hat/</tt></a>++<p>+This page last updated: 11th June 2002<br>+<a href="http://www.cs.york.ac.uk/fp/">+York Functional Programming Group</a><br>+Malcolm.Wallace@cs.york.ac.uk++</td></tr></table>+</body></html>+
+ docs/man/black-hat.1 view
@@ -0,0 +1,60 @@+.TH BLACK-HAT 1 local+.SH NAME+black-hat \- finds and displays a black-hole path+.SH SYNOPSIS+.B black-hat+[PROGNAME] [OPTION]... +.SH DESCRIPTION+.I black-hat+is a one-shot tool for displaying a simple trace of a+program containing a black-hole error. The trace shows the+pattern of function reductions from the first variable in the+black hole, to the next appearance of that variable. ++Note that the traced program must first be compiled using the+Hat tracing tools, and executed to generate a trace file. +.SH OPTIONS+Possible options are as follows:+.TP+.BI --showqual[=(t,f)]+control whether to show functions qualified by the name+of their module+.TP+.BI --cutoff=DEPTH+subexpressions in printed expressions are cut off and+replaced with a placeholder below a depth of DEPTH+.TP+.BI --showrt[=(t,f)]+control whether to show the root of the search path, or+just the path from the black-hole variable+.TP+.BI  --srcref[=(t,f)]+control whether to show source references for each+expression on the path+.TP+.BI  --showcount[=(t,f)]+control whether to show the number of accesses to the+file nodes+.TP+.BI  --shownode[=(t,f)]+(DEBUGGING OPTION)+control whether to show the octal addresses of the+expression nodes, along side the pretty-printed versions++.SH AUTHOR+Written by Mike Dodds.+.SH REPORTING BUGS+Report bugs to <hat@haskell.org>+.SH COPYRIGHT+Copyright \(co 2004 University of York.+.br+This is free software without warranty of any kind.+.SH SEE ALSO+.I hat-nonterm+is one of many tools in the+.I Hat+tracing system for Haskell programs.+For further information about+.I Hat+see+.B http://haskell.org/hat
+ docs/man/hat-anim.1.in view
@@ -0,0 +1,100 @@+.TH HAT-ANIM 1 local+.SH NAME+hat-anim \- animate the reduction of an expression+.SH SYNOPSIS+.B hat-anim+prog[.hat] num+.SH DESCRIPTION+.I hat-anim+is an interactive tool for exploring the forward reduction of a given+Haskell program+.I prog+supplied as its first argument.  The second argument+.I num+is an index into the Hat trace file, telling it where to begin.+Since you are unlikely to find a good starting point by guessing a+random number, we recommend you start hat-anim from within one of+the other hat tools, first choosing the relevant expression, then+issuing the :anim command.+.P+Exploration proceeds+.I forwards,+starting with the given expression, and at each step (press the space bar)+it shows the next reduction.++.SH INTERACTIVE COMMANDS+The following multi-letter commands are available.  They each begin+with a colon, bringing a visible command-line to the bottom of the+screen.  A command can be abbreviated to its shortest non-ambiguous+prefix.+.TP+.B :quit+Exit the interactive tool.+.TP+.B :help [cmd]+Shows help text giving an overview of the commands available, or if a+command name+.I cmd+is given, shows more detailed help about that command.+.TP+.B :set [flag]+With no argument, shows all current mode settings.  Given an argument,+it changes that mode and reports the new setting.  The flag argument+is one of:+.IP "  uneval [on|off]"+show unevaluated expressions in full (default off)+.IP "  strSugar [on|off]"+sugar character strings (default on)+.IP "  listSugar [on|off]"+sugar lists (default on)+.IP "  qualified [on|off]"+show all identifiers qualified (default off)+.IP "  equations [on|off]"+show rhs of equations (default off)+.IP "  srcrefs [on|off]"+show source reference of currently selected expression in the top bar+(default on)+.IP "  cutoff n"+cut-off depth for deeply nested exprs (default 10)+.TP+.B :+[n]+Short-cut to increase the cutoff depth by <n> (default 1)+.TP+.B :-[n]+Short-cut to decrease the cutoff depth by <n> (default 1)++.TP+.B :source+Shows (in a separate window) the source code for the application usage+currently highlighted.+.TP+.B :Source+Shows (in a separate window) the source code for the function+definition currently highlighted.+.TP+.B :detect+Start the hat-detect browser in a new window, beginning with the currently+selected expression.+.TP+.B :trail+Start another hat-trail browser in a new window, beginning with the currently+selected expression.+.TP+.B :observe [query]+With no argument, an interactive hat-observe window is started with the+function part of the currently selected expression used as the initial+query.  Given a query argument, the new window starts with a search+for the given expression pattern before giving an interactive prompt.++.TP+.B :resize+After resizing a window, use this command to inform the tool to detect+the change in size, so that pretty-printing can fit the screen.+++.SH FILES+.TP 25+.B @BINDIR@/hat-anim++.SH "SEE ALSO"+hmake(1), hat-trans(1), hat-stack(1), hat-observe(1), hat-detect(1)
+ docs/man/hat-cover.1 view
@@ -0,0 +1,66 @@+.TH HAT-COVER "1" "October 2004"+.SH NAME+hat-cover \- highlight Haskell source expressions used in a traced run +.SH SYNOPSIS+.B hat-cover+[\fIOPTION\fR]... [\fITRACEFILE\fR] [\fISOURCEFILE\fR]...+.SH DESCRIPTION+.PP+Print to standard output a listing of each Haskell \fISOURCEFILE\fR,+highlighting all expressions for which at least one instance occurs+in the \fBhat\fR \fITRACEFILE\fR.+.PP+The \fITRACEFILE\fR may be specifed with or without a+.C .hat+extension; similarly each \fISOURCEFILE\fR may be specified with or+without a+.C .hs+extension.+If no \fISOURCEFILE\fR is specified+.B hat-cover+lists all sources in which there are traced expressions.+.PP+The highlighted expressions in the output are \fImaximal\fR expressions+represented in \fITRACEFILE\fR.  However, case-expressions, if-expressions+and let-expressions are not included among the candidate maximal expressions.+As a result, in \fIoutermost\fR case/if/let layers each alternative, branch+or local definition is considered separately for highlighting.+.PP+However, where a case/if/let occurs as a part of a larger expression of some+other kind, any highlighting of the larger expression will also highlight+the entire case/if/let.+More generally, one+cannot infer from the highlighting of an expression that every subexpression+within it was needed at some point in the traced computation.+Extra detail in coverage information can be obtained if necessary+by lifting out key subexpressions as the right-hand-sides+of local definitions.+.TP+\fB\-hion=\fIonchars\fR, \fB\-hioff=\fIoffchars\fR+options reset the character-sequence codes used to switch highlighting+on and off in the output.+.SH AUTHOR+Written by Colin Runciman.+.SH "BUGS/LIMITATIONS"+Some lone-variable expressions are not candidate+maximal expressions for highlighting \(em but any entire+right-hand-side, or any alternative, branch or let-body in outermost+case/if/let layers, are always candidates.+Some trailing brackets in expressions are not included in highlighting.+Both problems are consequences of the current hat trace representation.+.SH "REPORTING BUGS"+Report bugs to <hat@haskell.org>.+.SH COPYRIGHT+Copyright \(co 2004 University of York.+.br+This is free software without warranty of any kind.+.SH "SEE ALSO"+.I hat-cover+is one of many tools in the+.I Hat+tracing system for Haskell programs.+For further information about+.I Hat+see+.B http://haskell.org/hat+
+ docs/man/hat-delta.1.in view
@@ -0,0 +1,151 @@+.TH HAT-DELTA 1 local+.SH NAME+hat-delta \- find a bug by algorithmic debugging, with delta debugging optimisations.+.SH SYNOPSIS+.B hat-delta+.RB [ \-chv ]+.RB [ \-d+.IR depth ]+.RB [ \-f+.IR heuristicFunction ]+.RB [ \-s+.IR sliceDepth ]+prog[.hat]++.SH DESCRIPTION+.I hat-delta+is an interactive tool for finding bugs in the trace of a Haskell program+.I prog+supplied as its argument.  The user must answer a sequence of yes/no+questions.  Each question asked by hat-delta concerns the reduction+of a function application to a value.  You answer+.I yes+if the reduction is correct with respect to your intentions, and+.I no+otherwise.+After a number of questions hat-delta reports an example equation+which is the cause of the observed faulty behaviour - that is, which+function definition is incorrect.++.SH OPTIONS+.TP+.B -c+Disable compression of the EDT based on reporting the same answer for several questions.+.TP+.B -d depth+Set the maximum depth hat-delta will consider making a jump into the EDT.+.TP+.B -f function+Set the heuristic function that hat-delta should use.  Heuristic functions are input in the form of a Haskell data structure as discussed in the Heuristic functions section.+.TP+.B -h+Display help message and exit.+.TP+.B -s sliceDepth+Set the number of child connections hat-delta will follow when generating a program slice.+.TP+.B -v+Print hat-delta's version number, and exit.++.SH INTERACTIVE COMMANDS+.PP+The hat-delta browser asks you questions, so the basic mode of+interaction is to type answers:+.TP+.B yes+Yes, the equation looks correct by my understanding of the meaning+of the function.+.TP+.B no+No, the equation looks incorrect.  Given the displayed arguments,+the function is returning the wrong result.+.PP+The following other commands are available.  They each begin with+a colon.+.TP+.B :show+Show the EDTs hat-detect is currently searching for bugs++.TP+.B :quit+Exit the interactive tool.+.TP+.B :help+Shows help text giving an overview of the commands available.++.TP+.B :source+Shows (in a separate window) the source code for the reduction currently being queried.+.TP+.B :anim+Start the hat-anim browser in a new window, beginning with the currently+queried rediction.+.TP+.B :delta+or+.B :split+Start the hat-delta browser in a new window, beginning with the currently+queried reduction.+.TP+.B :detect+Start the hat-detect browser in a new window, beginning with the currently+queried reduction.+.TP+.B :explore+Start the hat-explore browser in a new window, beginning with the currently+queried reduction.+.TP+.B :trail+Start a hat-trail browser in a new window, beginning with the currently+queried reduction.++.TP+.B :set+Set an option in the form `:set option value`. Options are:\n\+++.B depthLimit+Set the maximum depth hat-delta will consider making a jump into the EDT. Must be greater than 0.++.B sliceDepth+Set the number of child connections hat-delta will follow when generating a program slice. Must be positive.  A depth of 0 indicates that the whole function definition should be used as a slice.++.B heuristic+Set the heuristic function, as described in the Heuristic functions section.++.SH HEURISTIC FUNCTIONS+.PP+Heuristic functions calculate an estimate of how likely a particular program slice is to be the buggy one.  They may be specified by the user in the form of a Haskell data structure using the following constructors.+.TP+.B ZeroHeuristic+Constant 0.0+.TP+.B OneHeuristic+Constant 1.0+.TP+.B Correct+The number of correct evaluations of the slice.+.TP+.B Incorrect+The number of incorrect evaluations of the slice.+.TP+.B Add f1 f2+Add the values of f1 and f2.+.TP+.B Negate f+Negate the value of f.+.TP+.B Multiply f1 f2+Multiply the values of f1 and f2.+.TP+.B Invert f+Invert the value of f.+.PP+If no heuristic is specified, the system will use Negate (Multiply Correct (Invert (Add Correct Incorrect))).++.SH FILES+.TP 25+.B @BINDIR@/hat-delta++.SH "SEE ALSO"+hmake(1), hat-trans(1), hat-detect(1), hat-stack(1), hat-observe(1), hat-trail(1)
+ docs/man/hat-detect.1.in view
@@ -0,0 +1,76 @@+.TH HAT-DETECT 1 local+.SH NAME+hat-detect \- find a bug by algorithmic debugging+.SH SYNOPSIS+.B hat-detect+prog[.hat]+.SH DESCRIPTION+.I hat-detect+is an interactive tool for finding bugs in the trace of a Haskell program+.I prog+supplied as its argument.  The user must answer a sequence of yes/no+questions.  Each question asked by hat-detect concerns the reduction+of a function application to a value.  You answer yes if the reduction+is correct with respect to your intentions, and <em>no</em> otherwise.+After a number of questions hat-detect reports an example equation+which is the cause of the observed faulty behaviour - that is, which+function definition is incorrect.++.SH INTERACTIVE COMMANDS+.PP+The hat-detect browser asks you questions, so the basic mode of+interaction is to type answers:+.TP+.B yes+Yes, the equation looks correct by my understanding of the meaning+of the function.+.TP+.B no+No, the equation looks incorrect.  Given the displayed arguments,+the function is returning the wrong result.+.PP+The following other commands are available.  They each begin with+a colon.+.TP+.B :show+Show the EDTs hat-detect is currently searching for bugs+.TP+.B :children+Show the children of the current reduction.++.TP+.B :quit+Exit the interactive tool.+.TP+.B :help+Shows help text giving an overview of the commands available.++.TP+.B :source+Shows (in a separate window) the source code for the reduction currently being queried.+.TP+.B :delta+Start the hat-delta browser in a new window, beginning with the currently+queried reduction.+.TP+.B :detect+or+.B :split+Start the hat-detect browser in a new window, beginning with the currently+queried reduction.+.TP+.B :explore+Start the hat-explore browser in a new window, beginning with the currently+queried reduction.+.TP+.B :trail+Start a hat-trail browser in a new window, beginning with the currently+queried reduction.+++.SH FILES+.TP 25+.B @BINDIR@/hat-detect++.SH "SEE ALSO"+hmake(1), hat-trans(1), hat-delta(1), hat-stack(1), hat-observe(1), hat-trail(1)
+ docs/man/hat-nonterm.1 view
@@ -0,0 +1,66 @@+.TH HAT-NONTERM 1 local+.SH NAME+hat-nonterm \- finds and displays a non-termination path+.SH SYNOPSIS+.B hat-nonterm+[PROGNAME] [OPTION]... +.SH DESCRIPTION+.I hat-nonterm+is a one-shot tool for displaying a simple trace of+a non-terminating program. The tool picks a function likely to+be involved in the non-termination. It then displays a trace +containing some number of reductions of this function.++Note that the traced program must first be compiled using the+Hat tracing tools, and executed to generate a trace file. +.SH OPTIONS+Possible options are as follows:+.TP	+.BI --showqual[=(t,f)]+		control whether to show functions qualified by the name+		of their module+.TP+.BI --cutoff=DEPTH+		subexpressions in printed expressions are cut off and+		replaced with a placeholder below a depth of DEPTH+.TP+.BI --numfn=NUM+		control how many instances of the suspicious function +		appear on the displayed extract of the non-termination+		path+.TP+.BI --showrt[=(t,f)]+		control whether to show the root of the search path, or+		just the path from the suspicious function instance+.TP+.BI --srcref[=(t,f)]+		control whether to show source references for each+		expression on the path+.TP+.BI --showcount[=(t,f)]+		control whether to show the number of accesses to the+		file nodes+.TP+.BI --shownode[=(t,f)]+		(DEBUGGING OPTION)+		control whether to show the octal addresses of the+		expression nodes, along side the pretty-printed versions++.SH AUTHOR+Written by Mike Dodds.+.SH REPORTING BUGS+Report bugs to <hat@haskell.org>+.SH COPYRIGHT+Copyright \(co 2004 University of York.+.br+This is free software without warranty of any kind.+.SH SEE ALSO+.I hat-nonterm+is one of many tools in the+.I Hat+tracing system for Haskell programs.+For further information about+.I Hat+see+.B http://haskell.org/hat+
+ docs/man/hat-observe.1.in view
@@ -0,0 +1,156 @@+.TH HAT-OBSERVE 1 local+.SH NAME+hat-observe \- observe all arguments and results for a Haskell function+.SH SYNOPSIS+.B hat-observe+prog[.hat]+.SH DESCRIPTION+.I hat-observe+is an interactive tool to observe equations for all+applications of top-level functions during+the computation of the program+.I prog.+Each equation shows the specific arguments given to the function in+one call, together with the result of the call.  Identical calls are+suppressed, and it is possible to suppress calls that are less+general than other calls already seen.  There are various other options+for restricting the equations that are reported, for instance by+pattern-matching on certain arguments or results, by suppressing+recursive calls, or by restricting to a certain caller.++.SH INTERACTIVE COMMANDS+The following two commands constitute the basic method for using this+interactive browser.+.TP+.B pattern query+Show function/constructor applications matching the given pattern.+(See QUERY SYNTAX below for details.)  Equations are shown in groups+(of 10 by default) to avoid too many scrolling past at once.+.TP+.B <RETURN> key+Show the next group of equations for the most recent pattern query+(if more are available).+.PP+The following other commands are available.  They each begin with+a colon.  A command can be abbreviated to its shortest non-ambiguous+prefix.+.TP+.B :quit+Exit the interactive tool.+.TP+.B :help [cmd]+Shows help text giving an overview of the commands available, or if a+command name+.I cmd+is given, shows more detailed help about that command.  Also+.I :help query+shows the detailed syntax of observation queries.+.TP+.B :info [module]+Function identifiers are listed for the named module, or if no module+is named, then for all modules, sorted alphabetically, with occurrence+counts.  A blue count indicates completed calls, a red count indicates+uncompleted calls (unevaluated call counts are not shown).+.TP+.B :Info [module]+As for :info, except it lists data constructors rather than functions.+.TP+.B :set [flag]+With no argument, shows all current mode settings.  Given an argument,+it changes that mode and reports the new setting.  The flag argument+is one of:+.IP "  uneval [on|off]"+show unevaluated expressions in full (default off)+.IP "  strSugar [on|off]"+sugar character strings (default on)+.IP "  listSugar [on|off]"+sugar lists (default on)+.IP "  recursive [on|off]"+show recursive calls (default on)+.IP "  qualified [on|off]"+show all identifiers qualified (default off)+.IP "  equations [on|off]"+show rhs of equations (default on)+.IP "  [all|unique]"+show all equations or only unique (default unique)+.IP "  group n"+number of equations listed per page (default 10)+.IP "  cutoff n"+cut-off depth for deeply nested exprs (default 10)+.TP+.B :+[n]+Short-cut to increase the cutoff depth by <n> (default 1)+.TP+.B :-[n]+Short-cut to decrease the cutoff depth by <n> (default 1)++.TP+.B :source n+Shows (in a separate window) the source code for the application usage+of the numbered equation.+.TP+.B :Source n+Shows (in a separate window) the source code for the function+definition of the numbered equation.+.TP+.B :detect n+Start the hat-detect browser in a new window, beginning with the numbered+equation.+.TP+.B :trail n+Start the hat-trail browser in a new window, beginning with the numbered+equation.+.TP+.B :observe [query]+With no argument, a new interactive hat-observe window is started for+the same traced program.  Given a query argument, the new window starts+with an immediate search for the expression pattern before giving+an interactive prompt.+.TP+.B :resize+After resizing a window, use this command to inform the tool to detect+the change in size, so that pretty-printing can fit the screen.+++.SH QUERY SYNTAX+A simple function identifier finds all applications of that function.+     e.g. myfn++To restrict the number of equations, follow the function name with+argument or result patterns.+     e.g. myfn ((:) 1 ((:) 2 _))+          myfn "Hello World!" (1:(2:_)) = [1,_]++Another way of refining the search is to ask for calls only from a+specific enclosing function.+     e.g. myfn _ (Con 2 _) (1 `Con` 3) in myOtherFn++The full query syntax is:+.IP+.I    ident [pattern]*  ['=' pattern]?  ['in' ident]?+.HP+.B where+.PP+    pattern = '_'                             +            | num+            | ''' char '''+            | '"' string '"'+            | '[' pattern [',' pattern]* ']'+            | Con+            | '(' Con [pattern]* ')'++.PP+The pattern alternatives correspond (respectively) to a wildcard, a+number, a character, a string, a literal list, a nullary constructor,+and a constructor application.++Additionally, infix functions/constructors may take the normal+Haskell infix syntax.+++.SH FILES+.TP 25+.B @BINDIR@/hat-observe++.SH "SEE ALSO"+hmake(1), hat-trans(1), hat-stack(1), hat-detect(1), hat-trail(1)
+ docs/man/hat-stack.1.in view
@@ -0,0 +1,32 @@+.TH HAT-STACK 1 local+.SH NAME+hat-stack \- "virtual" stack trace for a crashed Haskell program+.SH SYNOPSIS+.B hat-stack+prog[.hat]+.SH DESCRIPTION+For aborted computations, that is computations that terminated+with an error message or were interrupted,+.I hat-stack+shows in which function call the computation was aborted.  It does+so by showing a virtual stack of function calls (redexes), i.e. every+function call on the stack caused the function call above it.  The+evaluation of the top stack element caused the error (or during+its evaluation the computation was interrupted).  The stack shown+is virtual, because it does not correspond to the actual runtime+stack.  The actual runtime stack enables lazy evaluation whereas the+virtual stack corresponds to a stack that would have been used for+eager (strict) evaluation.++.P+.B hat-stack+is now largely superseded by+.B hat-trail(1) which allows interactive browsing of the complete+call chain.++.SH FILES+.TP 25+.B @BINDIR@/hat-stack++.SH "SEE ALSO"+hmake(1), hat-trans(1), hat-observe(1), hat-detect(1), hat-trail(1)
+ docs/man/hat-trail.1.in view
@@ -0,0 +1,103 @@+.TH HAT-TRAIL 1 local+.SH NAME+hat-trail \- find a bug by backwards exploration of redex trails+.SH SYNOPSIS+.B hat-trail+prog[.hat]+.SH DESCRIPTION+.I hat-trail+is an interactive tool for exploring the trace of a given Haskell program+.I prog+supplied as its argument.  Exploration proceeds+.I backwards,+starting at the program output or an error message (with which the+computation aborted), finding at each step the direct parent expression+of the selected item.  This is particularly useful for locating an+error. You start at the observed faulty behaviour and work backwards+towards the source of the error.+.P+Every reduction replaces an instance of the left-hand side of a program+equation by an instance of its right-hand side.  The instance of the+left-hand side ``creates'' the instance of the right-hand side and is+therefore called its parent.  With hat-trail you can obtain+the parent of any expression or sub-expression already visible.++.SH INTERACTIVE COMMANDS+The following single-key commands are available for interactive+navigation of expressions.++The following multi-letter commands are available.  They each begin+with a colon, bringing a visible command-line to the bottom of the+screen.  A command can be abbreviated to its shortest non-ambiguous+prefix.+.TP+.B :quit+Exit the interactive tool.+.TP+.B :help [cmd]+Shows help text giving an overview of the commands available, or if a+command name+.I cmd+is given, shows more detailed help about that command.+.TP+.B :set [flag]+With no argument, shows all current mode settings.  Given an argument,+it changes that mode and reports the new setting.  The flag argument+is one of:+.IP "  uneval [on|off]"+show unevaluated expressions in full (default off)+.IP "  strSugar [on|off]"+sugar character strings (default on)+.IP "  listSugar [on|off]"+sugar lists (default on)+.IP "  qualified [on|off]"+show all identifiers qualified (default off)+.IP "  equations [on|off]"+show rhs of equations (default off)+.IP "  srcrefs [on|off]"+show source reference of currently selected expression in the top bar+(default on)+.IP "  cutoff n"+cut-off depth for deeply nested exprs (default 10)+.TP+.B :+[n]+Short-cut to increase the cutoff depth by <n> (default 1)+.TP+.B :-[n]+Short-cut to decrease the cutoff depth by <n> (default 1)++.TP+.B :source+Shows (in a separate window) the source code for the application usage+currently highlighted.+.TP+.B :Source+Shows (in a separate window) the source code for the function+definition currently highlighted.+.TP+.B :detect+Start the hat-detect browser in a new window, beginning with the currently+selected expression.+.TP+.B :trail+Start another hat-trail browser in a new window, beginning with the currently+selected expression.+.TP+.B :observe [query]+With no argument, an interactive hat-observe window is started with the+function part of the currently selected expression used as the initial+query.  Given a query argument, the new window starts with a search+for the given expression pattern before giving an interactive prompt.++.TP+.B :resize+After resizing a window, use this command to inform the tool to detect+the change in size, so that pretty-printing can fit the screen.+++.SH FILES+.TP 25+.B @BINDIR@/hat-trail++.SH "SEE ALSO"+hmake(1), hat-trans(1), hat-stack(1), hat-observe(1), hat-detect(1)
+ docs/man/hat-trans.1.in view
@@ -0,0 +1,145 @@+.TH HAT-TRANS 1 local+.SH NAME+hat-trans \- transform a Haskell module for tracing with the Hat system+.SH SYNOPSIS+.B hat-trans+[\-cpp [cppopts]]+[\-Idir]*+[\-package p]*+[transopts]+.I Mod.[l]hs ...+.SH DESCRIPTION+.I hat-trans+is a batch tool for transforming a Haskell program into one which+calculates its own trace.  It transforms each source module+.I Mod+supplied as arguments.  The modules may be ordinary source (.hs)+or literate source (.lhs).  The output is a transformed module,+whose name is the original module name prefixed with "Hat.", and it+is written to a file of similar name in the local subdirectory+.I Hat/+(except that .lhs becomes .hs, because the literate part is stripped).+If the subdirectory does not exist, it is created.  The original+source filename may include a directory path, in which case the+transformed module is placed in an identical directory tree underneath+the directory+.I Hat/.+This facilitates the easy transformation of modules within the+hierarchical module namespace.++The resulting transformed modules can be compiled and linked in the+normal way with your favorite Haskell compiler, with the addition+of the option+.I \-package hat+to its command-line.++Alternatively, rather than invoking+.I hat-trans+and a compiler by hand on your source files, but it is often more+convenient to allow+.I hmake(1)+to invoke the tools automatically, especially because it also+determines dependencies between modules and attempts to perform+the minimum re-compilation necessary.  Simple give the extra option+"-hat" to hmake.++.SH GENERAL OPTIONS+.TP+.B \-Idir+Use the directory+.I dir+as an additional root when searching for imported modules.+.TP+.B \-package p+The given source module(s) use standard modules from within the package+.I p+(this automatically adds the installed package root directory to the+import search path).+.TP+.B \-cpp+Invoke the C preprocessor on the source code before it is transformed.+This is useful for conditional transformation.+One cpp symbol is predefined, __HAT__, whose value is the version+number of the Hat toolset, expressed as a three digit integer, e.g.+version 2.02 gives __HAT__=202.  If the -cpp option is given, the+preprocessor is invoked on all the files given as arguments.  An+alternative which only invokes cpp on the files that really need it,+is to place a Haskell comment containing the string "-cpp" as the+first line of a source file.+.TP+.B \-Dsym=val+Define the cpp symbol+.I sym+to have the value+.I val+.TP+.B \-Dsym+Define the cpp symbol+.I sym+.TP+.B \-Usym+Undefine the cpp symbol+.I sym++.SH TRANSFORMATION OPTIONS+The following options are available to change the usual transformation+behaviour.+.TP+.B \-unlit+Unliterate the source code.  (Automatic if the file is .lhs)+.TP+.B \-nounlit+Do not unliterate the source code.  (Automatic if the file is .hs)+.TP+.B \-underscore+Treat underscores strictly as lowercase (default).+.TP+.B \-nounderscore+Treat underscores as invisible, e.g. _f is varid, _F is conid.+.TP+.B \-prelude+Treat prelude definitions specially.+.TP+.B \-noprelude+Do not treat definitions specially (default).+.TP+.B \-trusted+Make this a "trusted" module.+.TP+.B \-notrusted+Make this an "untrusted" module (default).+.TP+.B \-showwidth=w+Set output width (in characters) to+.I w+(default=80).+.TP+.B \-showindent=i+Set layout nesting indentation (in characters) to+.I i+(default=2).+.TP+.B \-showqualified+Use fully qualified names in the output.  This is off by default,+because the output may refer to modules which are not explicitly+imported.++.SH EXAMINATION OPTIONS+The following options are available to examine the internal progress+of the transformation.+.TP+.B \-lex+Show input after lexical analysis.+.TP+.B \-parse+Show syntax tree after parsing.+.TP+.B \-tracefns+Show syntax tree after tracing translation.++.SH FILES+.TP 25+.B @BINDIR@/hat-trans++.SH "SEE ALSO"+hmake(1), hat-detect(1), hat-observe(1), hat-trail(1), hat-stack(1)
+ docs/man/pretty-hat.1.in view
@@ -0,0 +1,30 @@+.TH PRETTY-HAT 1 local+.SH NAME+pretty-hat \- Produce a simplified graph of the trace file.+.SH SYNOPSIS+.B pretty-hat+prog [-d] [-x]+.SH DESCRIPTION+.I pretty-hat+is a tool for visualising the hat trace file for a program +.I prog+supplied as its argument.  The tool outputs a .dot file representing the trace.+This file should then be proccessed with the dotty graph layout program to+produce a final result.++.SH OPTIONS+.TP+.B -d+The tool should label nodes with the decimal value of their offset in the hat+trace file+.TP+.B -x+The tool should label nodes with the hexadecimal value of their offset in the+hat trace file++.SH FILES+.TP 25+.B @BINDIR@/pretty-hat++.SH "SEE ALSO"+hmake(1), hat-trans(1), hat-detect(1) hat-stack(1), hat-observe(1), hat-trail(1)
+ docs/new_tiny.gif view

binary file changed (absent → 147 bytes)

+ docs/newhat.ps.gz view

binary file changed (absent → 162937 bytes)

+ docs/news.html view
@@ -0,0 +1,47 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<html><head><title>Hat Project News</title></head>+<body text="#000000" bgcolor="#FFFFFF" link="#0000EE" vlink="#551A8B" alink="#FF0000">++<center>+  <img src="hat.gif" alt="Hat Logo"><br>+  <h1>Hat Project News</h1>+</center>+<hr>++<p>+<b>April 2005.</b>  The start of a new EPSRC-funded project,+"A Theory of Tracing Pure Functional Programs".  Yong Luo joins+Olaf Chitil as a Research Associate at the University of Kent.++<p>+<b>October 2004.</b> Tom Davie has become a Research Student under+Olaf Chitil at the University of Kent, investigating topics related+to tracing and Hat.++<p>+<b>April 2004.</b>  Two undergraduate projects at the University of+York have produced new tools for viewing Hat traces:  hat-anim from+Tom Davie, and hat-nonterm/black-hat from Mike Dodds.++<p>+<b>June 2002.</b>  The formal end of the EPSRC-funded project, "Advanced+Redex Trails", which developed version 2 of the Hat tracer.++<p>+<b>June 2000.</b> Olaf Chitil joins the ART project as a Research+Associate at the University of York.++<p>+<b>March 2000.</b> The start of an EPSRC-funded project, "Advanced+Redex Trails", involving Malcolm Wallace and Colin Runciman at the+University of York.++<p>+<b>September 1997.</b> The ROPA-funded project "Redex Trails" finishes.++<p>+<b>March 1996.</b> The ROPA-funded project "Redex Trails" starts.+Jan Sparud joins Colin Runciman at the University of York as a+research associate.++</body></html>
+ docs/old-tracing.html view
@@ -0,0 +1,71 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<HEAD>+<TITLE>The Haskell Tracer Project</TITLE>+</HEAD>++<BODY>++<H1>The Haskell Tracer Project</H1>++This page describes the current state of our Haskell tracer. The+theory about the tracing model, the implementation of the tracer, as+well as a user guide is included. We also provide a demonstration of+the tracer in action.<p>++<H3>Short introduction</H3>++We describe the design and implementation of an experimental system for+tracing Haskell computations.  The basis of our tracing method is a+program transformation carried out by the compiler: transformed+programs compute the same values as the original, but embedded in+functional data structures that also include <em>redex trails</em> showing+how the values were obtained.  When a final result is obtained in a+computation with redex trails, or when an error occurs, the programmer+can use a special-purpose interactive display program to investigate+the derivation in detail, with cross-links to the source program.<p>++Similar schemes attempted by others have typically been limited, for+example, with respect to the language used to express traced programs,+the speed of traced execution, the detail recorded in the trace, and+the size of computations for which traces can be built and explored.+We aim to build a tracer for full Haskell, and ultimately a tracer that+can be applied to large computations. Our present tracer, hosted by the+<em>nhc</em> compiler, handles most of Haskell. +<!-- Though applications to -->+<!-- date have been small, we can give examples of fully-traced computations -->+<!-- of upto a million reductions, derived from original programs several -->+<!-- pages in length. -->++<H3><a href="paper.dvi">Tracing Lazy Functional Computations (.dvi)</a></H3>++<H3><a href="old-demo/HTracer.html">+Demonstration of the tracer</a> (java required)</H3>++<H3>Snapshots</H3> ++This pictures below shows the tracer user interface when tracing the nhc +compiler. The top part of the window displays the interactive redex trail, +and the bottom part shows either the source code (the first picture) or +the program output (the second picture). <br>++<br><br>++The user can click on any expression, identifier or constant in the +redex trail display to explore the redex trail of that item. +By right-clicking on an item, the source code window will display the +source code position of <em>the particular occurrence</em> of the item.+By shift-right-clicking on an item, the source code window will display +the source code of <em>the definition</em> of the item.++<br><br>+<img src=compiler.gif>+<br><br>+If the output window is selected, the user can click on any part of the +program output, and the redex trail for the expression responsible for that +piece of the output will be display in the redex trail window.++<br><br>+<img src=compiler2.gif>+++</BODY>
+ docs/paper.dvi view

binary file changed (absent → 40172 bytes)

+ docs/proposal.html view
@@ -0,0 +1,838 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">+<HTML>+<HEAD><TITLE></TITLE></HEAD>+<BODY BGCOLOR=white TEXT=black>+<!--HTMLHEAD-->+<!--ENDHTML-->+<!--CUT DEF section 1 -->+<DIV ALIGN=center><FONT SIZE=6>Advanced Redex Trails:</FONT><BR><FONT SIZE=5>fully-fledged tracing technology for functional programs<BR>(project proposal)</FONT><BR><BR>+<FONT SIZE=4>Colin Runciman<BR>Department of Computer Science, University of York</FONT>+</DIV>+<p>+<EM>This is a revised version of the proposal submitted+to EPSRC, the research council that is funding the project.+Some minor sections giving personal or financial details,+or addressing issues of EPSRC policy, have been omitted.</EM><BR>+<BR>++<H5>Summary:</H5>+In many fields, high expectations of Information Technology are+limited in practice mainly by current methods of developing computer+software.+Declarative programming systems in general, and functional+languages in particular, have an important part to play in an improved+software technology. These languages free programmers from the need to+express specific sequences of calculation. They also provide powerful+ways of directly combining component functions. They are inherently+safer than programming languages now in widespread use, and+dramatically more concise.<BR>+<BR>+However, the very high-level nature of functional languages poses two+big problems: (1) how to turn programs into efficient computations; (2)+how to trace programming errors from the faults they cause.+Since the mid 1980s, problem (1) has been a popular target of research,+and excellent progress has been made with it: there are now optimising+compilers for functional languages. But problem (2) has received less+attention, and in practical terms it remains wide open. The lack of tracing+and debugging tools is a long-standing gap in functional-language technology,+deterring potential users.<BR>+<BR>+I therefore propose a decisive attack on the tracing problem for+functional programs. My aim is to advance a successful but limited+prototype, recently developed with ROPA funding, to the stage of a+convincing tool for practical application.+Several research problems must be solved to achieve this aim:+to give just two examples, efficient low-level counterparts must be found for+high-level combinators with subtle properties of abstraction, and+new algorithms are needed for incremental compression of+heap structures to file without disturbing lazy evaluation.+<BR>+<BR>++<H5>Key phrases:</H5> declarative languages; functional programming;+software development; fault-tracing tools; programming environments.<BR>+<BR>+<!--TOC section Context-->++<H2>1&nbsp;&nbsp;Context</H2><!--TOC subsection Past Projects-->++<H3>1.1&nbsp;&nbsp;Past Projects</H3>The broad aim of my work in recent years has been to advance the state+of the art in functional programming systems, enabling wider and more+effective use to be made of this technology. I have run a series of+research projects in this connection, with a mixture of government and+industrial funding. The most important of these for this proposal have+been:<BR>+<BR>++<H5>FLARE (1991--93, IEATP, GR/F 98857 C2117)</H5>+This project aimed to demonstrate that functional programming systems could be+effectively applied to a range of demanding applications. It was a+collaboration between industrial and academic partners, each of whom+developed applications in their own field of expertise. British+Telecom managed the project.+I was the technical+co-ordinator and co-edited a book based on the project [<CITE><A HREF="#runcimanwakeling95"><CITE>runcimanwakeling95</CITE></A></CITE>].+One important conclusion from FLARE was that the availability of+profiling and tracing tools can be a critical factor in the+successful use of functional programming.+At York we developed novel methods for+profiling heap memory [<CITE><A HREF="#runcimanwakeling93a"><CITE>runcimanwakeling93a</CITE></A></CITE>] and+parallel evaluation [<CITE><A HREF="#RuncimanWakeling94"><CITE>RuncimanWakeling94</CITE></A></CITE>].+There was not time to address the more complex tracing problem,+but it was put high on our list of topics for future research.<BR>+<BR>++<H5>Embedding Functional Programs (1994--, Canon Research Europe)</H5>+Towards the end of FLARE, a separate PhD project at York aimed to+adapt a functional language implementation for the special+requirements of embedded systems, including demands for memory+efficiency and a richer treatment of I/O [<CITE><A HREF="#wallacerunciman95b"><CITE>wallacerunciman95b</CITE></A></CITE>].+CRE has funded a continuation of this work.+The current techniques used for embedding software into+devices such as typewriters and copiers are a long way from purely+functional programming. But there are prototype software systems+developed on large workstations in declarative languages that Canon+might one day wish to embed in such office products. We have been+researching extensions to functional languages and their+implementations to make such embedding possible. A+significant part of this work has been a novel treatment of+compressed binary data [<CITE><A HREF="#WallaceRunciman98"><CITE>WallaceRunciman98</CITE></A></CITE>]:+this could be a useful part of our+tracing technology, where one of the key problems is to+reduce memory demands for trace structures representing entire+computational histories.<BR>+<BR>++<H5>Selective tracing of functional computations using graph reduction with+redex trails (1996--97, ROPA, GR/K64334)</H5>+This 18-month project aimed to demonstrate the feasibility of+a particular approach to the tracing problem by building a prototype+implementation. We extended a compiled graph-reduction implementation+of the functional language Haskell, transforming programs so that at+run-time they could build trails of contracted redexes (intermediate+expressions, re-written by appeal to definitions in the program) +attaching a comprehensive derivation+tree to every value [<CITE><A HREF="#sparudruncimanplilp97"><CITE>sparudruncimanplilp97</CITE></A></CITE>].+We developed a special purpose browser for the+examination of trails starting from outputs or run-time faults; we+experimented with partial trails and pruning rules to+increase the size of applications that could be handled [<CITE><A HREF="#SparudRuncimanIFL97"><CITE>SparudRuncimanIFL97</CITE></A></CITE>].+This ROPA project convinced us that redex trails can be made the basis+of an effective tracing system, useful in real applications.+<EM>The goal of the project now proposed is to fulfil this potential.+</EM><BR>+<BR>+<!--TOC subsection Institution-->++<H3>1.2&nbsp;&nbsp;Institution</H3>The Computer Science department at York has internationally+known research groups and attracted the highest possible rating (5*)+in the most recent national Research Assessment Exercise.+Software technology, including compilers and related tools,+is a long-standing theme in the department's work.<BR>+<BR>+<!--TOC section Proposed Research-->++<H2>2&nbsp;&nbsp;Proposed Research</H2><!--TOC subsection Background-->++<H3>2.1&nbsp;&nbsp;Background</H3>+<H5>The tracing problem</H5>+Functional programming systems offer significant advantages over more+conventional alternatives, particularly for complex symbolic+applications. The abstracting power and declarative nature of functional+languages, largely free from low-level concerns such as+sequence of evaluation and memory management, enable computational+ideas to be expressed very directly and concisely, with +fewer possibilities for error.<BR>+<BR>+However, this property of being abstract is two-edged. Though +there are fewer classes of possible mistakes in functional programs,+errors do still occur, and programmers need to trace their causes.+Time and again the lack of tools for tracing and debugging has deterred+software developers from using functional languages [<CITE><A HREF="#Wadler98"><CITE>Wadler98</CITE></A></CITE>].+This is not simple neglect on the part of implementors;+a high level of abstraction separating language from machine makes+tools genuinely hard to build.+A computation of a conventional imperative program is comparatively easy+to trace, step by step, but a functional computation performed using a+sophisticated evaluation strategy such as normal order graph reduction+involves a sequence of events not explicit in the program, and often+baffling to the intuition. Hence the research challenges: <EM>What is+an appropriate form of trace for functional computations? How best can+such traces be constructed and applied in practice?</EM><BR>+<BR>++<H5>Approaches to the problem</H5>+In the 1980s, little work was done on+profiling and tracing functional computations.+In the 1990s, work at York and elsewhere has+delivered effective profiling techniques, leading to+marked reductions in the time and space costs of many+applications [<CITE><A HREF="#RuncimanRojemoSchool96"><CITE>RuncimanRojemoSchool96</CITE></A>, </CITE><CITE><A HREF="#sansompeytonjonestoplas97"><CITE>sansompeytonjonestoplas97</CITE></A></CITE>].+Success with the tracing problem has not come so easily:+a review in a recent Australian thesis [<CITE><A HREF="#watsonphd"><CITE>watsonphd</CITE></A></CITE>] notes some twenty+different attempts at a solution, none of them conclusive!<BR>+<BR>+Approaches broadly divide into those that base traces on a <EM>linear+sequence</EM> of events, and those that represent computational history+using some sort of <EM>dependency graph</EM>. Methods based on a sequence of+events have had some success for `mostly functional' languages with a+strictly applicative evaluation sequence; Tolmach and Appel's system+for the ML language is a notable example [<CITE><A HREF="#tolmachappeljfp95"><CITE>tolmachappeljfp95</CITE></A></CITE>].+The benefits of+the sequential approach are that a trace can be displayed as+computation proceeds, and that it is easy to trade time for space:+given a few check-point states stored at well-chosen intervals, any past+state of computational history can be reached by re-execution.+<BR>+<BR>+However, the more ideal purely functional languages +permit the definition of non-strict functions, implemented using+the lazy evaluation strategy of call-by-need. Despite some valiant attempts [<CITE><A HREF="#watsonphd"><CITE>watsonphd</CITE></A></CITE>],+the evidence to date is that for such programs linear traces of the sequence of+reductions are ineffective. Rather, to track+faults in realistic computations, it is necessary to record a+non-linear structure of dependencies between expressions.<BR>+<BR>++<H5>Redex trails prototype</H5>+In our work, a network of <EM>redex trails</EM> [<CITE><A HREF="#sparudruncimanplilp97"><CITE>sparudruncimanplilp97</CITE></A>, </CITE><CITE><A HREF="#SparudRuncimanIFL97"><CITE>SparudRuncimanIFL97</CITE></A></CITE>]+represents these dependencies.+Functional expressions can be viewed as trees or --- since+sub-expressions can be shared and may recursively reference enclosing+expressions --- as graphs. Evaluation repeatedly replaces one subgraph+by another, where the reduction rules used to define replacements are+derived from equations that constitute the program. At each reduction+step, a <EM>redex</EM> matching the left-hand side of an equation is+replaced by the corresponding instance of the right-hand side. To+construct redex trails, at each reduction during the computation we+arrange that from every node <I>n</I> of the resulting subgraph there is a+link to the <EM>parent redex</EM> whose reduction caused <I>n</I> to be+introduced. Using a special-purpose browser which reconstructs+expressions in source form, the programmer can proceed backwards along+the relevant trails from a fragment of output, from a run-time error,+or from a point at which an apparently unproductive computation has been+interrupted. Our ROPA project has shown the viability of+this approach, as outlined in §1;+but despite its promising results, our ROPA prototype is limited+in a variety of ways, each prompting lines of further research:<BR>+<BR>+<OL>+<LI>+<EM>Performance:</EM>+A program transformed to generate redex trails can run 10--20 times+more slowly than the original.+<EM>Research questions</EM>: Could new abstract-machine instructions+provide low-level replacements for current high-level+combinators to manipulate trails? How can normally compiled functions+be mixed with trail-generating ones, when trail generation alters+type-structure at all levels?<BR>+<BR>++<LI>+<EM>Capacity:</EM>+Trails are constructed as data structures in heap memory.+Even partial redex trails are very large and current pruning strategies+may discard needed information.+<EM>Research questions</EM>: Could our heap compression techniques be+used to good effect here? Could some form of meta-programming be+used to give greater control over pruning?<BR>+<BR>++<LI>+<EM>Transience:</EM>+Because trails are built in heap memory, when a functional computation+is closed the trail is lost.+<EM>Research question</EM>: How can trails be archived to file incrementally+as computation proceeds? (This is a delicate problem because of the relationship+between trails and lazy evaluation, and the need to avoid revising the+archive.)<BR>+<BR>++<LI>+<EM>Scope:</EM>+Important classes of Haskell programs cannot yet be traced.+For example, I/O is very restricted, and comprehensions are traced+in terms of their low-level translations.+<EM>Research questions</EM>: What extensions to the current definition+of redex trails best represent these forms of+computation? What form of access and display are most effective+for these extensions?<BR>+<BR>++<LI>+<EM>Host:</EM> +The prototype is implemented as an extension of the <EM>nhc</EM> compiler+and run-time system. It cannot be used in conjunction+with other implementations (eg. the optimising compiler <EM>ghc</EM>).+<EM>Research questions</EM>: How can the current machinery for+redex trails be re-expressed in a portable tracer? If source-to-source+translation is used, could a low-level library with an interface+defined in Green Card [<CITE><A HREF="#GreenCard97"><CITE>GreenCard97</CITE></A></CITE>] or H/Direct [<CITE><A HREF="#HDirect98"><CITE>HDirect98</CITE></A></CITE>] provide+the necessary extension of primitives?+If so, assuming what interface to the local run-time system?<BR>+<BR>++<LI>+<EM>User interface:</EM>+The prototype trail browser was developed <EM>ad hoc</EM>.+It is quite complex and using it successfully+sometimes requires an implementor's insight.+<EM>Research questions</EM>:+How can fault-tracing be modelled as a problem-solving activity?+How well do the resources provided by the trail browser fit the task?+How can these and other insights be reflected in improved design,+including greater support for fault-finding strategies?</OL>One consequence of these limitations and outstanding research questions+is that the prototype has had few users --- mainly the developers and+their students.+The obstacles to wider practical use do not seem insurmountable,+but there is a lot of work to be done, requiring various skills.<BR>+<BR>++<H5>Other alternatives</H5>+Though we have developed redex trails as the basis for tracing,+we are aware of alternatives.+Perhaps the most advanced of these is Nilsson's Freja system, based on+Evaluation Dependence Trees (EDTs) [<CITE><A HREF="#NilssonPhd98"><CITE>NilssonPhd98</CITE></A></CITE>]. His EDT nodes record+equivalences between expressions, where each parent equivalence+is a direct consequence of the child equivalences and an+equation in the program. +The starting point in an EDT is not+a final reduction leading to an output or point of error but+the root equivalence between an original main expression and its+entire computed result.+Two drawbacks of the EDT approach in comparison with redex trails+are that incremental archiving to file is even more difficult+(Nilsson rules it out in favour of repeated execution to obtain+new fragments of the EDT) and that the user has to reason+about larger displayed expressions.<BR>+<BR>+<!--TOC subsection Programme and Methodology-->++<H3>2.2&nbsp;&nbsp;Programme and Methodology</H3>+<H5>Overall aim:</H5>+a solution to the problem of tracing higher-order lazy+functional computations that is effective in practice, based on tools+for the construction and examination of redex trails.<BR>+<BR>++<H5>Primary objectives</H5>+<OL>+<LI>+a <EM>tracing system for Haskell 98</EM> (the nearest thing+there is to a standard lazy functional language) hosted in+the freely available <EM>nhc</EM> compiler;+<BR>+<BR>++<LI>+a system that incorporates a method for <EM>incremental archiving+of traces to file</EM>, alleviating pressure on heap memory and+increasing the returns from the overhead of generating trails;<BR>+<BR>++<LI>+a <EM>portable variant</EM> of the tracer, based on source-to-source+transformation and a support library, with a clearly-defined+interface to supporting operations that any host implementation+must provide; (In particular, we aim to provide a version of+our tracer that works in conjunction with the widely-used+<EM>ghc</EM> and <EM>hugs</EM> systems, currently being integrated with+EPSRC support --- GR/L 34297.)<BR>+<BR>++<LI>+a trace-browser designed to be <EM>an effective tool for locating+faults</EM> based on a thorough analysis of+the tracing task as a problem-solving activity, and of the+browser display as a resource; the browser will also be+equipped to record how it is used, so that data+can be gathered from use in practice.</OL>+<H5>Secondary objectives</H5><OL>+<LI>+to <EM>improve the speed</EM> of computations generating trails,+for example by transferring the operations of trail-level function+abstraction and application to a lower layer of implementation;<BR>+<BR>++<LI>+to obtain <EM>results from a wide range of practical tests</EM> using the+tracer, and hence to improve the design --- eg. to determine+what strategies users choose to adopt when examining traces, and to+extend the tracer with explicit support for the strategies that seem+most successful;<BR>+<BR>++<LI>+to exploit the representation of redex trails as functional+data structures by devising a system for <EM>meta-programming+search and display routines</EM> specific to an application.+</OL>+<H5>Timeliness and novelty</H5>The need for a tracing tool that can cope with lazy higher-order+functional programs has been recognised for almost twenty years. +The lack of a tracer has been a key reason for the+surprisingly limited use of a programming technology+with so many advantages [<CITE><A HREF="#Wadler98"><CITE>Wadler98</CITE></A></CITE>].+There are now optimising compilers for languages like Haskell,+and tools for the integration of functional components into+larger systems.+A solution to the tracing problem is overdue.+It is a difficult problem to tackle comprehensively,+but the redex trails approach is distinctive, and with+the results already obtained in the ROPA project+we are well-placed to succeed.<BR>+<BR>++<H5>Methodology</H5>+A lot of work has gone into our ROPA prototype, with promising+results.+We should advance from the given position, not restart from scratch.+The principles of the compile-time transformation,+the functional representation of redex trails, and the+message-passing architecture of the tracer (browser+communicating with functional computation) should+all be preserved.+We shall also continue to work with the <EM>nhc</EM> compiler,+but reducing dependencies on its internal world to increase+portability.+Java was used for the prototype browser, and proved+quite satisfactory.+Though we plan to re-think the browser design, implementation+will again be in Java --- a browser that works well+over the internet could prove useful when we want+to support external users.<BR>+<BR>+So far as practical evaluation is concerned, we do <EM>not</EM>+intend to set up rigorous laboratory experiments scrutinising+tracing `micro-tasks'.+Such experiments would absorb too much effort.+Results from actual use in practice are preferable for our purpose,+but general feedback from casual use might be too vague or sparse.+One kind of evaluation exercise we intend to use+requires two programmers.+<I>A</I> explains to <I>B</I> a correctly working program of+moderate size (around 500 lines) that <I>A</I> wrote some+time ago.+<I>B</I> now secretly introduces several deliberate+errors into the program, of a kind undetected by the compiler.+Given the faulty program, <I>A</I> uses the tracer to locate+and fix all the errors, thinking aloud as they do so.+<I>B</I> takes notes throughout, and afterwards <I>A</I> and <I>B</I> review the+exercise, recording the main issues arising.<BR>+<BR>++<H5>Programme of work</H5>Figure 1 summarises the workplan in diagrammatic form.+From the start, the two researchers will engage in joint +tasks combining their skills as well as solo tasks+demanding their individual expertise.+Brief descriptions follow for each activity.+<BLOCKQUOTE><HR>+<BR>+<BR>+<DIV ALIGN=center>Figure 1: </DIV>+<HR></BLOCKQUOTE><OL>+<LI>+<EM>Acquire skill with prototype:</EM>+Both RAs need to become expert users of the+prototype tracer to inform their work developing its successor.+Each will also need to become+familiar with components of the implementation for which they will be+responsible.<BR>+<BR>++<LI>+<EM>Tracing as a problem-solving task:</EM>+Newell and Simon [<CITE><A HREF="#NewellSimon72"><CITE>NewellSimon72</CITE></A></CITE>] pioneered ways of analysing the+human information processing required to solve a variety of problems,+such as chess puzzles. We will similarly analyse the activity of using+the tracer to locate faults in programs. The purpose is to gain+understanding of tasks that must be supported by an improved browser+for redex trails, including strategies that users might in principle+choose to adopt.<BR>+<BR>++<LI>+<EM>Display as resource:</EM>+The display provided by the browser is a critical resource, as typical+redex trails are complex and very large. Using techniques previously+applied to theorem-proving systems, we shall model display information+as a resource for reasoning about programs [<CITE><A HREF="#FieldsWrightHarrison97"><CITE>FieldsWrightHarrison97</CITE></A></CITE>].+The results will inform+the redesign of the browser.<BR>+<BR>++<LI>+<EM>Lift language restrictions:</EM>+The top priorities are list comprehensions and file I/O.+Comprehensions require new transformation rules;+file I/O requires special support from the run-time+system; both require extensions to+the browser interface.<BR>+<BR>++<LI>+<EM>Incremental archiving:</EM>+We hope to achieve incremental archiving by extending trail-pruning routines+applied by the+prototype during garbage collection. Information in sections of+trail deleted from heap memory will be archived to file, with the+continuing stump in the main memory trail recording an archival+reference. Care will be needed to avoid any costly revision of+archived values or undesirable change in the degree of +evaluation. Archived trails must also be properly linked to all the other+information that may be required by the browser (eg. program sources,+indexed I/O transcript).<BR>+<BR>++<LI>+<EM>Faster trail generation:</EM>+Trail-manipulating combinators are introduced by transformation+to replace each function abstraction and each+application in the original program. In the prototype, these+combinators are defined in Haskell as part of a+redex-trail library. We aim to define+new primitive operations, perhaps new G-machine+instructions in <EM>nhc</EM>, to make reduction of+these combinators much faster. However, degree of evaluation is+extremely delicate, particularly in the way that saturation of+function applications is handled, and some likely-looking+primitives fail at this point.+The ability to mix traced and untraced modules could give another+route to faster generation of selective trails.<BR>+<BR>++<LI>+<EM>Redesign browser:</EM>+Based on experience using the prototype, and the results of the+problem-solving and resource analyses, +the trail browser will be redesigned.+We shall try to minimise changes to the+message-passing interface with the Haskell world.+The browser will also be extended to record information+about how it is used.<BR>+<BR>++<LI>+<EM>Devise experiments and instructions:</EM>+Writing instructions for the use of the tracer, including+information about how to carry out systematic experiments,+will be an essential prelude to external use and feedback.+The exercise of writing about use of the tracer should+also provoke further insights into what is needed,+and ideas for development.<BR>+<BR>++<LI>+<EM>Interim release of tracer:</EM>+an important milestone.+All effort will focus at this stage on pulling together the+different strands of development in the first year, to provide a reliable+distribution of the tracer hosted by a version of nhc.+This will also be a good time to visit likely users.<BR>+<BR>++<LI>+<EM>Concerted trials of tracer:</EM>+We shall test the effectiveness of the tracer ourselves using+exercises of the kind noted under `methodology'.+Trials by external users will be promoted and supported+by mailing lists, visits and a workshop.<BR>+<BR>++<LI>+<EM>Analyse usage and revise models:</EM>+Study of the data automatically collected by the browser,+alongside reports and requests from users, will+confirm or alter our design assumptions and priorities.+The problem-solving and resource models will be revised,+and improvements made to the trail browsing interface.<BR>+<BR>++<LI>+<EM>Portability interface:</EM>+A portable variant of the tracer must be detached from <EM>nhc</EM>+in two respects.+Compile-time transformations working on internal representations+must be adapted to generate a fresh source.+Extra run-time routines required by the tracer should be+isolated, specified and defined in portable+libraries (Haskell 98, Green Card or H/Direct).+The portable version of the tracer must forfeit+some sources of efficiency that depend on internal properties of+<EM>nhc</EM>, but an optimising compiler such as <EM>ghc</EM> might+amply compensate for such losses.<BR>+<BR>++<LI>+<EM>Develop support for strategies:</EM>+Typical redex trails involve a large number of interconnecting+paths, and there are various plausible strategies for+investigating faults of different kinds.+Some of these could be directly supported by the tracer ---+for example, reducing display information by blocking off+parts of a trail irrelevant to a specific line of enquiry,+and automatically following any unique continuations.+The choice of strategies to support will be informed by+discussion with experienced users, and examination of usage+logs.<BR>+<BR>++<LI>+<EM>Metaprogramming display and search:</EM>+Redex trails are functional data structures so there is scope for+trace-time computation over them.+For example, displays of some large data structures could be+vastly improved by application-specific rules --- though care+must be taken to avoid forcing evaluation unnaturally.+We also plan to investigate ways of encoding specialised+searches over trails.<BR>+<BR>++<LI>+<EM>Final release and documentation:</EM>+A Haskell implementation incorporating the new tracer, with+explanatory papers, will be made available on the internet.+Another task in the closing stages will be to finish writing up +results of our work for refereed publication.</OL>+<H5>Project management</H5>A weekly project meeting will provide a regular occasion to+review current progress and confirm immediate plans. With a small team,+working closely together, these meetings will naturally be informal.+However, written records will be kept to avoid misunderstandings+or things being forgotten.+Interested visitors may be invited to join these meetings,+and regular meetings of the Programming Languages and Systems research group+will give further opportunity for brief reports and discussion.<BR>+<BR>+Once a quarter we shall review progress on the project as a whole,+revising plans if necessary to secure the most important objectives.+We shall also issue a short quarterly bulletin to our academic and+industrial contacts, and any other interested parties. <BR>+<BR>+<!--TOC subsection Dissemination and exploitation-->++<H3>2.3&nbsp;&nbsp;Dissemination and exploitation</H3>We shall seek in various ways to encourage both+academic and industrial Haskell users+to try our new tracer, and to participate in its+further development. The plan is to release an experimental+version of the tracer at the end of the first year, as the+common platform for a concerted period of trial use. We shall make+suitable advance announcements on the internet, seek opportunities to+present our work on the tracer at recognised conferences, and +also hold a one-day workshop at York. Within the UK,+we may visit users to get them started. Besides establishing a mailing list for+general feedback and discussion, we shall publish details of+suggested forms of tracing experiment on the web.<BR>+<BR>+There are several archival FTP sites for public domain implementations+of functional languages. We plan to make the final results of our work freely+available by placing copies of software at these sites, in addition to+publishing papers.<BR>+<BR>+<!--TOC subsection Resources-->++<H3>2.4&nbsp;&nbsp;Resources</H3>The appropriate scale for this project has been determined by+comparison with the 18-month ROPA project during which the+prototype redex-trail system was developed.<BR>+<BR>++<H5>People</H5>+If we are to push this tracing technology far enough to+make it really effective in practice, there is a lot of work to be done on several+fronts.+Hence the proposal to hire a team of two post-doctoral RAs for two years.+<BR>+<BR>++<H5>Infrastructure and equipment</H5>+The department of Computer Science at York provides+computing facilities including networking and file-service,+with technician support.+<BR>+<BR>+Each of the RAs will need a workstation.+The two most common platforms for+developers and users of research languages are Suns and PCs.+Of these, PCs offer better performance for the price --- and we+have access to an UltraSparc compute server if a Sun platform is needed.+At the time of writing £2000 buys a PC system including a 400MHz+Pentium II processor, 128Mb RAM, 8.4Gb disk, 17"--19" monitor, CDROM,+network and graphics cards.+Suitable components will be chosen and purchased+separately, and assembled by our departmental technicians.<BR>+<BR>++<H5>Travel</H5>We request funds to participate in relevant conferences. ICFP is the+premier international conference in functional programming; INTERACT is+an international conference with user interface design as a central+interest.+IFL is an established European workshop emphasising+new implementation methods and practical experiments in functional+programming.+The costing assumes that we all attend ICFP+but only two of us attend each of IFL and INTERACT.+<BR>+<BR>+We hope to maintain close working links with researchers in Sweden.+Jan Sparud (Gothenburg) worked on the ROPA project, and we value+continuing collaboration with him.+Henrik Nilsson (Linköping) has developed a rival approach+to functional tracing, based on Evaluation Dependence Trees. We propose to +visit Sweden twice a year.+<BR>+<BR>+Within the UK, we have links with relevant research groups at several+other universities, from Exeter to St Andrews, and with industrial R&amp;D+sites, mainly in the South. We request funds for+visits to discuss the development of the tracer, and to+promote its experimental use.+<BR>+<BR>+<!--TOC section References-->++<H2>References</H2><DL COMPACT>+<DT><FONT COLOR=purple>[FieldsWrightHarrison97]<A NAME="FieldsWrightHarrison97"></A></FONT><DD>+B.&nbsp;Fields, P.&nbsp;Wright, and M.&nbsp;Harrison.+ Objectives, strategies and resources as design drivers.+ In S.&nbsp;Howard, J.&nbsp;Hammond, and G.&nbsp;Lindgaard, editors, <EM>Human-Computer Interaction </EM><EM>INTERACT'97</EM>, pages 164--171. Chapman and Hall,+ July 1997.<BR>+<BR>++<DT><FONT COLOR=purple>[FieldsMerriam98]<A NAME="FieldsMerriam98"></A></FONT><DD>+R.&nbsp;E. Fields and N.&nbsp;A. Merriam.+ Inference and information resources: A design case study.+ In P.&nbsp;Johnson and P.&nbsp;Markopoulos, editors, <EM>Eurographics Workshop+ on Design, Specification and Verification of Interactive Systems</EM>. Springer,+ 1998.+ In press.<BR>+<BR>++<DT><FONT COLOR=purple>[HDirect98]<A NAME="HDirect98"></A></FONT><DD>+S.&nbsp;Finne, D.&nbsp;Leijen, E.&nbsp;Meijer, and S.&nbsp;L. Peyton Jones.+ H/Direct: a binary foreign language interface for Haskell.+ In <EM>Proc. 3rd ACM International Conference on Functional+ Programming (</EM><EM>ICFP'98</EM><EM>)</EM>, pages 153--162. ACM Press, September 1998.<BR>+<BR>++<DT><FONT COLOR=purple>[NewellSimon72]<A NAME="NewellSimon72"></A></FONT><DD>+A&nbsp;Newell and H.&nbsp;A. Simon.+ <EM>Human Problem Solving</EM>.+ Prentice-Hall, 1972.<BR>+<BR>++<DT><FONT COLOR=purple>[NilssonPhd98]<A NAME="NilssonPhd98"></A></FONT><DD>+H.&nbsp;Nilsson.+ <EM>Declarative debugging for lazy functional languages</EM>.+ PhD thesis, Linköping, Sweden, 1998.<BR>+<BR>++<DT><FONT COLOR=purple>[GreenCard97]<A NAME="GreenCard97"></A></FONT><DD>+S.&nbsp;L. Peyton Jones, T.&nbsp;Nordin, and A.&nbsp;Reid.+ Green Card: a foreign language interface for Haskell.+ In <EM>P</EM><EM>roc. </EM><EM>ACM</EM><EM> </EM><EM>SIGPLAN</EM><EM> </EM><EM>H</EM><EM>askell </EM><EM>W</EM><EM>orkshop, </EM><EM>A</EM><EM>msterdam</EM>,+ June 1997.<BR>+<BR>++<DT><FONT COLOR=purple>[rojemofpca95]<A NAME="rojemofpca95"></A></FONT><DD>+N.&nbsp;Röjemo.+ Highlights from nhc --- a space-efficient Haskell compiler.+ In <EM>P</EM><EM>roc. 7th </EM><EM>I</EM><EM>ntl. </EM><EM>C</EM><EM>onf. on </EM><EM>F</EM><EM>unctional </EM><EM>P</EM><EM>rogramming+ </EM><EM>L</EM><EM>anguages and </EM><EM>C</EM><EM>omputer </EM><EM>A</EM><EM>rchitecture (</EM><EM>FPCA'95</EM><EM>)</EM>, pages 282--292. ACM+ Press, June 1995.<BR>+<BR>++<DT><FONT COLOR=purple>[RuncimanRojemoSchool96]<A NAME="RuncimanRojemoSchool96"></A></FONT><DD>+C.&nbsp;Runciman and N.&nbsp;Röjemo.+ Heap profiling for space efficiency.+ In J.&nbsp;Launchbury, E.&nbsp;Meijer, and T.&nbsp;Sheard, editors, <EM>2nd </EM><EM>I</EM><EM>ntl.+ </EM><EM>S</EM><EM>chool on </EM><EM>A</EM><EM>dvanced </EM><EM>F</EM><EM>unctional </EM><EM>P</EM><EM>rogramming</EM>, pages 159--183, Olympia,+ WA, August 1996. Springer LNCS Vol. 1129.<BR>+<BR>++<DT><FONT COLOR=purple>[runcimanwakeling93a]<A NAME="runcimanwakeling93a"></A></FONT><DD>+C.&nbsp;Runciman and D.&nbsp;Wakeling.+ Heap profiling of lazy functional programs.+ <EM>Journal of Functional Programming</EM>, 3(2):217--245, April 1993.<BR>+<BR>++<DT><FONT COLOR=purple>[RuncimanWakeling94]<A NAME="RuncimanWakeling94"></A></FONT><DD>+C.&nbsp;Runciman and D.&nbsp;Wakeling.+ Profiling parallel functional computations (without parallel+ machines).+ In J.T. O'Donnell and K.&nbsp;Hammond, editors, <EM>Proc. 1993 Glasgow+ Workshop on Functional Programming</EM>, pages 236--251. Springer-Verlag+ Workshops in Computing, 1994.<BR>+<BR>++<DT><FONT COLOR=purple>[runcimanwakeling95]<A NAME="runcimanwakeling95"></A></FONT><DD>+C.&nbsp;Runciman and D.&nbsp;Wakeling, editors.+ <EM>Applications of functional programming</EM>.+ UCL Press, 1995.<BR>+<BR>++<DT><FONT COLOR=purple>[sansompeytonjonestoplas97]<A NAME="sansompeytonjonestoplas97"></A></FONT><DD>+P.&nbsp;M. Sansom and S.&nbsp;L. Peyton Jones.+ Formally based profiling for higher-order functional languages.+ <EM>ACM Transactions on Programming Languages and Systems</EM>,+ 19(2):334--85, March 1997.<BR>+<BR>++<DT><FONT COLOR=purple>[SparudRuncimanIFL97]<A NAME="SparudRuncimanIFL97"></A></FONT><DD>+J.&nbsp;Sparud and C.&nbsp;Runciman.+ Complete and partial redex trails of functional computations.+ In C.&nbsp;Clack, K.&nbsp;Hammond, and T.&nbsp;Davie, editors, <EM>Selected papers+ from 9th Intl. Workshop on the Implementation of Functional Languages+ (</EM><EM>IFL'97</EM><EM>)</EM>, pages 160--177. Springer LNCS Vol. 1467, September 1997.<BR>+<BR>++<DT><FONT COLOR=purple>[sparudruncimanplilp97]<A NAME="sparudruncimanplilp97"></A></FONT><DD>+J.&nbsp;Sparud and C.&nbsp;Runciman.+ Tracing lazy functional computations using redex trails.+ In H.&nbsp;Glaser, P.&nbsp;Hartel, and H.&nbsp;Kuchen, editors, <EM>Proc. 9th Intl.+ Symposium on Programming Languages, Implementations, Logics and Programs+ (</EM><EM>PLILP'97</EM><EM>)</EM>, pages 291--308. Springer LNCS Vol. 1292, September 1997.<BR>+<BR>++<DT><FONT COLOR=purple>[tolmachappeljfp95]<A NAME="tolmachappeljfp95"></A></FONT><DD>+A.&nbsp;Tolmach and A.&nbsp;W. Appel.+ A debugger for Standard ML.+ <EM>Journal of Functional Programming</EM>, 5(2):155--200, April 1995.<BR>+<BR>++<DT><FONT COLOR=purple>[Wadler98]<A NAME="Wadler98"></A></FONT><DD>+P.&nbsp;Wadler.+ Why no one uses functional languages.+ <EM>ACM SIGPLAN Notices</EM>, 33(8):23--27, August 1998.<BR>+<BR>++<DT><FONT COLOR=purple>[wallacerunciman95b]<A NAME="wallacerunciman95b"></A></FONT><DD>+M.&nbsp;Wallace and C.&nbsp;Runciman.+ Lambdas in the Liftshaft --- functional programming and an+ embedded architecture.+ In <EM>Proc. 7th Intl. Conf. on Functional Programming Languages and+ Computer Architecture (FPCA'95)</EM>, pages 249--258, La Jolla, June 1995. ACM+ Press.<BR>+<BR>++<DT><FONT COLOR=purple>[WallaceRunciman98]<A NAME="WallaceRunciman98"></A></FONT><DD>+M.&nbsp;Wallace and C.&nbsp;Runciman.+ The bits between the lambdas: Binary data in a lazy functional+ language.+ In <EM>Proc. Intl. Symp. on Memory Management</EM>, pages 107--117,+ Vancouver, Canada, October 1998. ACM Press.<BR>+<BR>++<DT><FONT COLOR=purple>[watsonphd]<A NAME="watsonphd"></A></FONT><DD>+R.&nbsp;D. Watson.+ <EM>Tracing Lazy Evaluation by Program Transformation</EM>.+ PhD thesis, Southern Cross, Australia, October 1996.</DL>+++<!--HTMLFOOT-->+<!--ENDHTML-->++<!--FOOTER-->+<HR>++<BLOCKQUOTE><EM>This document was translated from L<sup>A</sup>T<sub>E</sub>X by </EM><A HREF="http://para.inria.fr/~maranget/hevea/index.html"><EM>H</EM><EM><FONT SIZE=2><sup>E</sup></FONT></EM><EM>V</EM><EM><FONT SIZE=2><sup>E</sup></FONT></EM><EM>A</EM></A><EM>.+</EM></BLOCKQUOTE></BODY>+</HTML>+
+ docs/publications.html view
@@ -0,0 +1,224 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<html>++<head>+<title>Hat publications</title>+</head>++<body text="#000000" bgcolor="#FFFFFF" link="#0000EE" vlink="#551A8B" alink="#FF0000">++<center>+<img src="hat.gif" alt="Hat Logo"><h1>Hat publications</h1>+</center>++<ul>++<li>Olaf Chitil<br>+<strong>A Theory of Tracing Pure Functional Programs</strong><br>+<p>+During the development of the Haskell tracer Hat, which combines the tracing+methods of several preceding systems, numerous inconsistencies, anomalies and+defects in all existing systems came to light. Experience in using the systems+suggests desirable generalisations that are hard to realise. At the root of+both problems is that the development of the existing systems was+implementation-driven, guided mostly by intuition. There is a surprising lack+of theoretical foundations for tracing. To resolve the inconsistencies and+enable generalisations, this project aims at establishing a semantical theory+of tracing pure functional programs, both eager and lazy, that describes+different methods, links information gained from tracing to specific program+parts, and establishes the correctness of fault location algorithms.+<br><a href="http://www.cs.kent.ac.uk/people/staff/oc/traceTheory.html">Web+link</a>++<li>Koen Claessen, Colin Runciman, Olaf Chitil, John Hughes,+    Malcolm Wallace:<br>+<strong>Testing and Tracing Lazy Functional Programs+        using QuickCheck and Hat</strong><br>+<em>4th Summer School in Advanced Functional Programming, Oxford</em>,+August 2002, 40 pages (final version in Springer LNCS 2638, 2003).+<p>+One motivation for using a functional programming language is that+it is more difficult (or even impossible) to make low-level mistakes,+and it is easier to reason about programs.  But even the most advanced+functional programmers are not infallible; they misunderstand the+properties of their own programs, or those of others, and so commit+errors.  We therefore aim to provide functional programmers with+tools for testing and tracing programs.  In broad terms, testing+means first specifying what behaviour is acceptable in principle,+then finding out whether behaviour in practice matches up to it across+the input space.  Tracing means first recording the internal details+of a computation, then examining what is recorded to gain insight, to+check hypotheses or to locate faults.  We concentrate on QuickCheck,+a tool for testing Haskell programs, and Hat, a tool for tracing them.+Each tool is useful in its own right, but they are even more useful+in combination: testing using QuickCheck can identify failing cases,+tracing using Hat can reveal the causes of failure.+<br><a href="afp2002.ps.gz">Postscript</a> (preliminary version) (103 KB)+<br><a href="http://www.springerlink.com/link.asp?id=9qhce993jrecc9dx">+LNCS abstract and PDF</a> (final version)+<p>++<li>Olaf Chitil, Colin Runciman, Malcolm Wallace:<br>+<strong>Transforming Haskell for Tracing</strong><br>+in <em>International Workshop on the Implementation of Functional+Languages</em>, Madrid, Sept 2002, 17 pages, final version to appear+in Springer LNCS series, 2003.+<p>+Hat is a programmer's tool for generating a trace of a computation of+a Haskell 98 program and viewing such a trace in various different+ways.  Applications include program comprehension and debugging.+A new version of Hat uses a stand-alone program transformation to+produce self-tracing Haskell programs.  The transformation is small+and works with any Haskell 98 compiler that implements the standard+foreign function interface.  We present general techniques for+building compiler independent tools similar to Hat based on program+transformation.  We also point out which features of Haskell 98 caused+us particular grief.+<br><a href="ifl2002.ps.gz">Postscript</a> (preliminary version) (84 KB)+<p>++<li>Olaf Chitil:<br>+<strong>A Semantics for Tracing</strong><br>+in <em>Draft Proceedings of the 13th+International Workshop on Implementation of Functional Languages, IFL 2001</em>,+Älvsjö, Sweden, 24-26 September 2001,+editors Thomas Arts and Markus Mohnen,+Ericsson Computer Science Laboratory,+pp. 249-254.+<p>+We define a small step operational semantics for a core of Haskell. We modify+this semantics to generate traces, specifically Augmented Redex Trails. This+small and direct definition of Augmented Redex Trails shall improve our+understanding of them and shall help to extend them systematically.+<br><a href="http://www.cs.york.ac.uk/~olaf/PUBLICATIONS/traceSemantics.ps.gz">+Postscript</a> (44 KB)+<p>++<li>Thorsten Brehm:<br>+<strong>A Toolkit for Multi-View Tracing of Haskell Programs</strong><br>+Master's Thesis, RWTH Aachen, 2001, 130 pages.+<br><a href="toolkitThesis.ps.gz">Postscript</a> (225 KB)+<p>++<li>Malcolm Wallace, Olaf Chitil, Thorsten Brehm, and Colin Runciman:<br>+<strong>Multiple-View Tracing for Haskell: a New Hat</strong><br>+<em>Proceedings of the+    <A HREF="http://www.cs.uu.nl/people/ralf/hw2001.html">Haskell Workshop 2001</A>, Firenze, Italy.</em>+FInal version to appear in ENTCS.+<p>+Different tracing systems for Haskell give different views of a+program at work.  In practice, several views are complementary+and can productively be used together.  Until now each system has+generated its own trace, containing only the information needed for+its particular view.  Here we present the design of a trace that can+serve several views.  The trace is generated and written to file as+the computation proceeds.  We have implemented both the generation+of the trace and several different viewers.+<br><a href="newhat.ps.gz">Postscript</a> (106 KB)+<p>+++<li>Olaf Chitil, Colin Runciman and Malcolm Wallace:<br>+<strong>Freja, Hat and Hood - A Comparative Evaluation of Three Systems+        for Tracing and Debugging Lazy Functional Programs</strong><br>+  <em>Markus Mohnen and Pieter Koopman (eds): Proceedings of the+  <A HREF="http://www-i2.informatik.rwth-aachen.de/ifl2000/">+  12th International Workshop on Implementation of Functional Languages</A>,+  Aachen, Germany, September 4th - 7th 2000, LNCS 2011, 2001, pp. 176-193.</em>+<p>+In this paper we compare three systems for tracing and debugging+Haskell programs: Freja, Hat and Hood.  We evaluate their usefulness in+practice by applying them to a number of moderately complex programs+in which errors had deliberately been introduced. We identify the+strengths and weaknesses of each system and then form ideas on how+the systems can be improved further.<br>+<a href="frejaHatHood.ps.gz">Postscript</a> (84 KB)+<p>++<li>Colin Runciman:<br>+<strong>Advanced Redex Trails: Project Proposal</strong><br>+<a href="proposal.html">(.html)</a>+<p>++</ul>++Publications not directly about Hat, but produced as a spin-off+result of the Hat project:+<ul>++<li>Olaf Chitil:<br>+<strong>Compositional Explanation of Types and Algorithmic Debugging of Type+        Errors</strong><br>+Proceedings of the <em>Sixth ACM SIGPLAN International Conference on+Functional Programming (ICFP'01)</em>, Firenze, Italy, 3-5 September 2001,+pp. 193--204.+<p>+The type systems of most typed functional programming languages+are based on the Hindley-Milner type system. A practical problem+with these type systems is that it is often hard to understand why a+program is not type correct or a function does not have the intended+type. We suggest that at the core of this problem is the difficulty+of explaining why a given expression has a certain type. The type+system is not defined compositionally. We propose to explain types+using a variant of the Hindley-Milner type system that defines a+compositional type explanation graph of principal typings. We describe+how the programmer understands types by interactive navigation through+the explanation graph. Furthermore, the explanation graph can be+the foundation for algorithmic debugging of type errors, that is,+semi-automatic localisation of the source of a type error without+even having to understand the type inference steps. We implemented a+prototype of a tool to explore the usefulness of the proposed methods.+<br><a href="http://www.cs.york.ac.uk/~olaf/PUBLICATIONS/explainTypes.ps.gz">+Postscript</a> (139 KB)+<p>++<li>Olaf Chitil:<br>+<strong>Pretty Printing with Lazy Dequeues</strong><br>+Proceedings of the <em>2001 ACM SIGPLAN Haskell Workshop</em>, Firenze,+Italy, Universiteit Utrecht UU-CS-2001-23, 2 September 2001, pp. 183-201.+<p>+There are several Haskell libraries for converting tree structured data+into indented text, but they all make use of some backtracking. Over+twenty years ago Oppen published a more efficient imperative+implementation of a pretty printer without backtracking. We show that+the same efficiency is also obtainable without destructive updates+by developing a similar but purely functional Haskell implementation+with the same complexity bounds. At its heart lie two lazy double+ended queues.+<br><a href="http://www.cs.york.ac.uk/~olaf/PUBLICATIONS/pretty.ps.gz">+Postscript</a> (138 KB)+<p>++</ul>++Hat is the successor of an earlier project and builds on its work+which is described in the following publications:+<ul>++<li>Jan Sparud and Colin Runciman:<br>+<strong>Tracing Lazy Functional Computations Using Redex Trails</strong><br> +(PLILP'97)+<a href="ftp://ftp.cs.york.ac.uk/pub/colin/plilp97.ps.gz">(.ps.gz)</a>+<p>++<li>Jan Sparud and Colin Runciman:<br>+<strong>Complete and Partial Redex Trails of Functional Computations</strong><br>+(IFL'97)+<a href="http://www.cs.chalmers.se/~sparud/papers/ifl97.ps.gz">(.ps.gz)</a>+<p>++<li>Jan Sparud:<br> +<strong>Tracing and Debugging Lazy Functional Computations</strong><br>+(PhD thesis, 1999)+<a href="http://www.sparud.net/phd/phd.ps.gz">(.ps.gz)</a>++</ul>++<p>+<hr>+This page last modified: 28 June 2005<br>+<a href="http://www.cs.york.ac.uk/fp/">+York Functional Programming Group</a><br>+</body>++</html>
+ docs/requirements.html view
@@ -0,0 +1,106 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<html><head><title>Hat system requirements</title></head>+<body bgcolor=#ffffff>+<table><tr><td width=500>++<center>+  <img src="hat.gif" alt="Hat Logo"><br>+  <h1>Hat system requirements</h1>+</center>++<hr>+<h3>You will need...</h3>+<p>+To build and use Hat, you will need+<ul>+<li> a Haskell'98 compiler that supports the standard FFI (i.e.+     <a href="http://www.haskell.org/nhc98/">nhc98</a> or+     <a href="http://www.haskell.org/ghc/">ghc</a>)+<li> the <a href="http://www.haskell.org/hmake/">hmake</a> compilation manager+<li> GNU make+<li> a C compiler (usually gcc)+<li> at least 128Mb of memory (256Mb with ghc -O)+<li> disk space: 30Mb (nhc98), 50Mb (ghc)+</ul>+Here are the minimum versions of software that we recommend: anything+earlier than these is unlikely to interoperate correctly with Hat-2.04.++<center>+<table cellspacing=5>+<tr><th>software</th><th>minimum version</th></tr>+<tr><td>ghc</td><td>5.04.2</td></tr>+<tr><td>nhc98</td><td>1.18</td></tr>+<tr><td>hmake</td><td>3.07</td></tr>+<tr><td>gcc</td><td>2.8.1</td></tr>+</table>+</center>++<p>+You only need one Haskell compiler - the Hat installation procedure+will detect what you already have and use it.  However, it is+absolutely essential that you have <em>hmake</em>.  Not only is it+needed to build the various Hat tools, but you will also need it when+you want to build tracing versions of your own programs.++<p>+You must also have a Unix-like operating system environment with+X windows, in particular the <em>resize</em> command, and the+<em>xterm</em> terminal emulator supporting ANSI colour codes.  This is+used when you start one browsing tool from within another, to bring+up a new text window.  If you are using the Windows operating system,+then <a href="http://www.cygwin.com/">Cygwin</a> is the appropriate+environment to use - it includes the eXceed X-server.  For MacOS X,+you should install the <a href="http://www.apple.com/macosx/x11/">Apple+XFree86</a> server, or an equivalent.++<p>+If you do not have <em>gcc</em> as your C compiler, you will need to+ensure that your <em>CC</em> environment variable is set to the name+of your C compiler at the configuration stage.  For instance,+<pre>    CC=cc   ./configure --buildwith=...</pre>++<p>+The browsing tools may use the <em>glib</em> C library, which is+related to the larger <em>gtk+</em> set of libraries.  If it is+available, the automatic configuration of Hat will detect and use it.+(If it is not available, our own replacement code will be used,+but it is slightly slower.)  If glib is available, it is important+that you have version glib-1.2.x (although you may also have another+version glib-2.0.x installed simultaneously).  The latest version+in the 1.2.x series is <em>glib-1.2.10</em>, and it is available+from <a href="ftp://ftp.gtk.org/pub/gtk/v1.2/">ftp.gtk.org</a>.++<h3>GHC requirements</h3>+<p>+If you have <em>ghc</em>, then a <em>package</em> is built, containing+various Hat libraries.  The installation procedure attempts to+install the new `hat' package in the system directories that belong+to <em>ghc</em>.  You must have the appropriate permissions to write+into those directories, and sufficient permissions to update the+system-wide <em>ghc</em> package configuration.  (The installation+and configuration is performed automatically.)++<h3>nhc98 requirements</h3>+<p>+If you have <em>nhc98</em>, then a <em>package</em> is built, containing+various Hat libraries.  The installation procedure attempts to+install the new `hat' package in the system directories that belong+to <em>nhc98</em>.  You must have the appropriate permissions to write+into those directories.  (The installation is performed automatically.)++<hr>+<p>+The latest updates to these pages are available on the WWW from+<a href="http://www.haskell.org/hat/">+<tt>http://www.haskell.org/hat/</tt></a><br>+<a href="http://www.cs.york.ac.uk/fp/hat/">+<tt>http://www.cs.york.ac.uk/fp/hat/</tt></a>++<p>+This page last modified: 12th October 2004<br>+<a href="http://www.cs.york.ac.uk/fp/">+York Functional Programming Group</a><br>++</td></tr></table>+</body></html>+
+ docs/status.html view
@@ -0,0 +1,149 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<html><head><title>Hat status</title></head>+<body bgcolor="#ffffff">+<table><tr><td width=530>++<center>+  <img src="hat.gif" alt="Hat Logo"><br>+  <h1>Hat status</h1>+</center>++<hr>++<p>+The latest stable release is 2.06.  The CVS development tree is now+at version 2.07.  Bugfixes and important changes to the system are+described here for the two most recent released versions.++<p>++<hr>+<h3>Hat 2.06 (2008-10-02) features</h3>+<ul>+<li> New tool: hat-delta (debugging by comparison of traces).+<li> New tool: pretty-hat (displays a graph of the trace itself).+<li> Improved: hat-detect (algorithmic debugging).+<li> Improved: detection of ghc version under MacOS X.+<li> Improved: no longer need admin rights to install the Hat libraries for ghc.+<li> Bugfix: hat-trans: copes with literate files .lhs.+<li> Bugfix: hat-trans: FFI foreign imports now work.+<li> Bugfix: hat-trans: better handling of relative directory paths.+<li> Bugfix: hat-trans: largest size of a named-field update increased+                        from 2 to 10.+<li> Bugfix: hat-trans: top-level pattern-bindings now work.+<li> Bugfix: hat-trans: name clashes from 'deriving' clauses eliminated.+<li> Bugfix: libraries: correct printing of floating point numbers.+</ul>++<hr>+<h3>Hat 2.04 (2005-05-17) features</h3>+<ul>+<li> We have included more libraries from the hierarchical base package as+     standard, so more programs should be immediately traceable.+<li> The algorithmic debugging technique has been re-instated with+     the resurrection of the <em>hat-detect</em> browser.+<li> The browsers are better integrated with each other, sharing a common+     set of commands and options.+<li> A new browser, <em>hat-anim</em> is provided.  It animates the+     reduction sequence of a selected expression, showing the lazy evaluation+     strategy, and revealing intermediate calls between application and result.+<li> The new browser <em>hat-explore</em> allows interactive exploration of+     the trace with simultaneous source highlighting, to narrow down the+     location of a bug through program-slicing.+<li> Some new non-interactive tools: <em>hat-cover</em> shows the test+     coverage of the source code for a traced program run;+     <em>hat-nonterm</em> finds the circular set of definitions that causes+     a program to fall into a non-terminating loop.+<li> A significant performance improvement in the speed of running traced code.+<li> Many small bugfixes for correctness of the transformation.+<li> Works fully with ghc-6.2 and ghc-6.4+</ul>++<hr>+<h3>Hat 2.02 (2003-03-26) features</h3>+<ul>+<li> New:	Hat supports hierarchical module namespaces, and+		the distribution includes a tracing version of (a subset of) the+		<em>base</em> package of standard hierarchical libraries.+<li> New:	Hat supports multi-parameter type classes and functional+		dependencies, provided your underlying compiler supports them+		(i.e. ghc).+<li> New:	The browsing tools support qualified name syntax.+<li> Performance: The speed of traced programs is now much improved.  There+		is a new "known-arity" optimisation within Hat itself, which+		gives a speed-up of ~20-40%.  Also, if you use --buildwith=-O+		when configuring Hat for ghc, you will get another 20-40%+		improvement.  Beware however that -O requires a <em>lot</em>+		of memory (&ge;512Mb).+<li> Bugfix: Named field constructions and updates are now displayed in+             the browsing tools as named fields.+<li> Bugfix: The viewing tools displayed some sugared lists misleadingly:+             when the tail of a sugared list was cut off or undefined it+             was shown as if it was a final element.  Now it has an+             ellipsis (...) to indicate possible extra elements.+<li> Bugfix: After <em>:set recursive off</em> hat-observe showed the+             non-recursive calls of f even if given the application+             pattern <em>f in f</em>.+<li> Bugfix: hat-observe :info counts did not necessarily match+             the number of observations if there were partial or+             super-saturated applications.+<li> Bugfix: hat-trail now works correctly in environments (e.g. Solaris)+             that do not have <tt>stty cbreak</tt> mode.+<li> Bugfix: Scrolling sometimes blanked the upper part of the hat-trail+             display when the trace was extended deeper than the window.+<li> Bugfix: The hat-trail display became corrupted if a single trail+             expression or equation was large enough to scroll off the screen.+<li> Bugfix: Hat-trans generated wrongly-parenthesised code for some+             lambda expressions.+<li> Bugfix: Hat-trans generated incorrect values for some non-printing+             characters.+<li> Tidyup: For consistency, the :observe command within hat-observe now+             starts a fresh hat-observe window.  Also, in hat-trail, if+             if you give a query pattern to the :observe command, it now uses+             that as the first query, instead of the currently highlighted+             function.+<li> Numerous other small bugfixes in the various trace browsing tools.+</ul>++<h3>Hat 2.00 (2002-06-14) features</h3>+<ul>+<li> The first version released separately from nhc98.  It uses+     a different file format to store the trace, and the browsing+     tools have been completely rewritten to improve performance,+     integration, and correctness.+</ul>+++<hr>++<h3>Status of various components</h3>++<p>+The basic components of <em>hat</em> are:+<ul>+   <li> hat-trans, the program transformer.+   <li> hat-lib, the runtime library that is linked to a transformed program.+   <li> hat-observe, a browser driven by expression patterns.+   <li> hat-trail, a browser driven by backward exploration.+   <li> hat-detect, a browser implementing algorithmic debugging. (NOT INCLUDED)+   <li> hat-stack, a browser showing a back-trace from an error.+   <li> hat-view, a source-code viewer.+   <li> hat-check, to verify the integrity of a .hat file.+</ul>++<hr>+<p>+The latest updates to these pages are available on the WWW from+<a href="http://www.haskell.org/hat/">+<tt>http://www.haskell.org/hat/</tt></a><br>+<a href="http://www.cs.york.ac.uk/fp/hat/">+<tt>http://www.cs.york.ac.uk/fp/hat/</tt></a>++<p>+This page last modified: 2nd Oct 2008<br>+<a href="http://www.cs.york.ac.uk/fp/">+York Functional Programming Group</a><br>++</td></tr></table>+</body></html>+
+ docs/todo.html view
@@ -0,0 +1,200 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<html><head><title>Hat 2.04 Wish List</title></head>+<body text="#000000" bgcolor="#FFFFFF" link="#0000EE" vlink="#551A8B"+alink="#FF0000">++<center>+  <img src="hat.gif" alt="Hat Logo"><br>+  <h1>Hat 2.04 Wish List</h1>+</center>+<hr>++<p>+This is a list of wishes (not bugs) to improve Hat 2.04.+Elsewhere, there is a <a href="bugs.html">bug list</a> of things+that are incorrect.  Please report any more wishes you can+think of to: <a href="mailto:hat@haskell.org">hat@haskell.org</a>.++<h3>Little Wishes</h3>+<ol>++<li>+  backspace to correct slips in : command-lines+  <font color=red>(Use stty erase ^H if readline is not available)</font>++<li>+  separate cutoff length for strings from general cutoff depth++<li>+  advice for users wishing to use hat but not hmake++<li>+  in hat-observe allow application patterns after "in"++<li>+  in hat-observe, an option to show the number of instances of+  each uniquely represented application++<li>+  in hat-observe bring back % progress indicators++<li>+  in any viewing tool accept :S [qualified] name++<li>+  scrolling and resizing of source windows (with line numbers instead+  of fixed source reference line)+   +<li>+  viewing tools compare time-stamps of trace files with those+  of sources and issue warning if appropriate+   +</ol>++<h3>Bigger Wishes</h3>+<ol>++<li>+    combine traced and untraced modules by a more drastic wrapping+    (eg. data structures of type T computed within the wrapped module+    recorded as {T}) and subclassing to get around mismatch of+    method types (eg. Ord T =&gt; TOrd T and Ord a =&gt; Ord (R a))++<li>+    support tracing of locally defined functions by recording+    bindings for free variables (eg. add refs to static parent+    names in local name nodes and extend local argument lists to+    include free variables defined within top-level parent with+    the name entries for these variables)+   +<li>+    with or without 2, hat-observe to support observation of+    locally defined functions or data values if :set locals on.+    Locals to be listed by :i (indented below their parents?)+    and observations of locals to be split into same-instance+    groups (headed by whatever contextual bindings for variables+    are available)+   +<li>+    extensional observation by hat-observe of a (\..) selected+    in hat-trail (important to ensure that all observations+    are of exactly this function not just a function with same+    source)+   +<li>+    evaluation windows with bindings to selected expressions+    from trace viewers (quite easy for expressions that only contain+    top-level function names and/or fully evaluated data; anything+    else poses representation problems)+   +<li>+    hat-trail to list the sequence of IO actions, not just text+    output to stdout+   +<li>+    further decompose textual output into pieces connected by ++++<li>+    hat-trail to support multiple steps along trails Eg:+    - to nearest ancestral application of any top-level function+    - to nearest ancestral application of a named function+    - to nearest non-recursive ditto++<li>+    hat-trail to support single-step forward reduction from a redex+    (perhaps shown as indented lines starting -&gt;)+   +<li>+    option to assert trust in named modules or top-level functions+    in all trace-viewing tools++<li>+    hat-detect for new-format traces including correct handling of +    untrusted computation in a trusted context and an option to show+    all children of current EDT node +    <font color=red>Done, see hat-detect</font>+<li>+    generalise hat-observe to hat-query, with a user-programmable+    query language for more general and powerful access to the+    hat trace than current commands+   +<li>+    user-programmable display of expressions in textual or graphical+    form++<li>+    hat-observe option to see arguments and results of trusted+    (and perhaps other) functions that have 0-arity definitions+   +<li>+    a coordinating environment for tracing that, for example,+    automatically closes trace windows when program is modified+    and/or run again+   +<li>+    a tool that cleanly truncates a trace file as if the computation+    had been interrupted at some specified break-point+   +<li>+    more support in hat-trail for tracing parent uses of zero-arity+    definitions and their source locations+   +<li>+    run-time options to report the number of reductions (or other+    computational steps) in an untraced computation and to report+    corresponding numbers (or better still, a % indicator) at+    intervals during a traced computation++<li>+    make source windows active, for example allowing selection of+    an application or function for observation in hat-observe+   +<li>+    editable command lines with readline functionality+    <font color=red>Done</font>++<li>+    special-purpose tool to locate black-holes in traces+    <font color=red>Done, see black-hat</font>++<li>+    add an evaluation bit to projection/forward nodes allowing+    {_}/{?} to be displayed as _ where appropriate++</ol>++<h3>Controversial Wishes</h3>+<ol>++<li>+   option to show lambda expressions in full++<li>+   a graphical user interface for hat viewers++<li>+   always display error "... message ..." if available, not _|_++<li>+   a Free Navigation viewer+    <font color=red>Done, see hat-source</font>++<li>+   support for tracing stateful monadic computations in terms+   of sequences of states+   +<li>+   option to use unification instead of one-way matching with+   application patterns in hat-observe+   +<li>+   :o in hat-trail to use the currently selected expression as+   the implicit application pattern to observe++</ol>++<hr>+<p>+This page last updated: 5th February 2003<br>+</body></html>+
+ docs/toolkitThesis.ps.gz view

binary file changed (absent → 225525 bytes)

+ docs/tracing.html view
@@ -0,0 +1,61 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">+<HEAD>+<TITLE>Introduction to the prototype Haskell Tracer </TITLE>+</HEAD>++<BODY>++<H1>Introduction to the prototype Haskell Tracer</H1>++<H3>Overview</H3>++<p>+The prototype Haskell Tracer is an experimental system for tracing+Haskell computations.  The basis of our tracing method is a program+transformation carried out by the compiler: transformed programs+compute the same values as the original, but in addition compute+functional data structures containing <em>redex trails</em> which+show how the values were obtained.  After computing a result,+or when an error occurs, the programmer can use a special-purpose+interactive display program to investigate the derivation in detail,+with cross-links to the source program.++<p>+Similar schemes attempted by others have typically been limited, for+example, with respect to the language used to express traced programs,+the speed of traced execution, the detail recorded in the trace, and+the size of computations for which traces can be built and explored.+We aim in the ART project to build a tracer for full Haskell'98,+and ultimately a tracer that can be applied to very large computations.+Our prototype tracer, hosted by the <em>nhc98</em> compiler,+currently handles most of the Haskell'98 language, with a subset of+the Standard Prelude and Libraries.  Various techniques have already+been incorporated for dealing with larger computations.++<H3><a href="paper.dvi">Tracing Lazy Functional Computations (.dvi)</a></H3>++<H3>User Interface</H3> ++<p>+The picture below illustrates the tracer user interface, here shown+tracing the nhc98 compiler itself. The top part of the window displays+the interactive redex trail, and the bottom part shows either the+source code or the program output (selected via the notebook tabs).++<p>+The user can click on any expression, identifier or constant in the +redex trail display to explore the redex trail of that item. +By right-clicking on an item, the source code window will display the +source code position of <em>the particular occurrence</em> of the item.+By shift-right-clicking on an item, the source code window will display +the source code of <em>the definition</em> of the item.++<p>+If the output window is selected, the user can click on any part of the +program output, and the redex trail for the expression responsible for that +piece of the output will be displayed in the redex trail window.++<p>+<img src=compiler2.gif>++</BODY>
+ docs/tutorial1.hva view
@@ -0,0 +1,3 @@+\newcommand{\highlight}[1]{\red{\tt #1}\black}+\newcommand{\mkblue}[1]{\blue{\tt #1}\black}+\newcommand{\CUT}{\char177}
+ docs/tutorial1.tex view
@@ -0,0 +1,730 @@+\documentclass[12pt]{article}++\usepackage[a4paper]{geometry}++\newif\ifpdf+\ifx\pdfoutput\undefined+  \pdffalse+\else+  \pdfoutput=1+  \pdftrue+\fi++\ifpdf+  \usepackage[colorlinks=true]{hyperref}+  \usepackage[pdftex]{graphicx}+  \pdfcompresslevel=9+\else+  \usepackage{graphicx}+\fi++%------------------------------------------------------------------------------++++\newcommand{\CUT}{\mbox{\rule{1.0ex}{1.5ex}}}+\newcommand{\highlight}[1]{\raisebox{0pt}[2ex][2ex]{\fbox{\tt #1}}}+\newcommand{\mkblue}[1]{#1}+\begin{document}+\title{Hat Tutorial}+\author{The ART Team \\+{\tt ART-team@cs.york.ac.uk}}+\date{29 April 2005}+\maketitle+\section{Introduction}++This tutorial is intended as a practical introduction to the+Hat tools\footnote{+Available from {\tt http://www.haskell.org/hat/}.}+for tracing Haskell 98 programs.+It introduces the basic ideas+and explains with worked examples how to use the tools.++Readers are encouraged to follow the+tutorial using an installation of Hat.+This first version of the tutorial assumes Hat (Version 2.04), nhc98, hmake+ and Linux, but it works equally+well with ghc instead of nhc98.++There are several Hat tools for examining traces, but this tutorial will+consider only two: {\tt hat-trail} and {\tt hat-observe}.+Even for these tools not every option and command is discussed.+For a more comprehensive reference see the Hat User Manual.++The tutorial makes use of a small example program ---+at first a correctly working version, later one with faults+deliberately introduced.+The intended behaviour of the program is very+simple: it should sort the letters of the word `program' using insertion sort.+The working program is given\footnote{+The program may also be found in the file {\tt Insort.hs}.}+in Figure~\ref{insort}.++\begin{figure}[t]+\fbox{\parbox{\textwidth}{+\begin{tabular}{lcl}+\multicolumn{3}{l}{\tt sort ::\ Ord a => [a] -> [a]} \\+{\tt sort []}     & {\tt =} & {\tt []} \\+{\tt sort (x:xs)} & {\tt =} & {\tt insert x (sort xs)}+\end{tabular} \\+\begin{tabular}{lcl}+\multicolumn{3}{l}{\tt insert ::\ Ord a => a -> [a] -> [a]} \\+{\tt insert x []}     & {\tt =} & {\tt [x]} \\+{\tt insert x (y:ys)} & {\tt =} & {\tt if x <= y then x :\ y :\ ys} \\+{\tt }                & {\tt  } & {\tt else y :\ insert x ys}+\end{tabular} \\+\begin{tabular}{lcl}+{\tt main} & {\tt =} & {\tt putStrLn (sort "program")}+\end{tabular}+}}+\caption{\label{insort}An insertion-sort program.}+\end{figure}++\section{Hat Compilation and Execution}++To use Hat, the Haskell program to be traced must first be+compiled with the {\tt -hat} option to {\tt hmake}:++\begin{tabbing}+{\tt \$ hmake -hat Insort} \\+{\tt hat-trans Insort.hs} \\+{\tt Creating directories Hat} \\+{\tt Wrote Hat/Insert.hs} \\+{\tt nhc98 -package hat -c -o Hat/Insort.o Hat/Insort.hs} \\+{\tt nhc98 -package hat -o Insort Hat/Insort.o}+\end{tabbing}++A program compiled for tracing can be executed just as+if it had been compiled normally.+\begin{tabbing}+{\tt \$ Insort} \\+{\tt agmoprr}+\end{tabbing}+The main difference from untraced execution is that as {\tt Insort} runs+it records a detailed trace of its computation in a file {\tt Insort.hat}.+The trace is a graph of program expressions encoded in a special-purpose+binary format.++Two further files {\tt Insort.hat.output} and+{\tt Insort.hat.bridge}+record the output and associated references to the trace file.\footnote{+Trace files do not include program sources, but they do include+references to program sources; modifying source files could invalidate+source links from traces.}++\section{Hat-trail: Basics}++After a program compiled for tracing has been run, creating a trace file,+special-purpose tools are used to examine the trace.+The first such tool we shall look at is hat-trail.+The idea of hat-trail is to answer the question `Where did that come+from?' in relation to values, expressions, outputs and error messages.+The immediate answer will be a parent application or name.+More specifically:+\begin{itemize}+\item {\em errors}:+the application or name being reduced when the error occurred+(eg. {\tt head []} might be the parent of a pattern-match failure);++\item {\em outputs}:+the monadic action that caused the output+(eg. {\tt putStr "Hello world"} might the parent of a section of output text);+ +\item {\em non-value expressions}:+the application or name whose defining body+contains the expression of which the child is an instance+(eg. {\tt append [1,2] [3,4]} might be the parent of {\tt append [2] [3,4]});+ +\item {\em values}:+as for non-value expressions, or the application of a+predefined function with the child as result+(eg. {\tt [1,2]++[3,4]} might be the parent of {\tt [1,2,3,4]}).+\end{itemize}+Parent expressions, and their subexpressions, may in turn have parents+of their own.+The tool is called hat-trail because it+displays trails of ancestral redexes, tracing effects back to their+causes.++\subsubsection*{Hat-trail sessions and requests}+A hat-trail session can be started from a shell command line, or from+within existing sessions of hat tools.+The immediate result of the shell command+\begin{tabbing}+{\tt \$ hat-trail Insort}+\end{tabbing}+is the display of a terminal window with an upper part headed {\tt Output}+and a lower part headed {\tt Trail}:+\begin{tabbing}+{\tt Output:\ -------------------------------------------------------} \\+\highlight{agmoprr\char92n} \\+\\+{\tt Trail:\ ------ hat-trail 2.00  (:h for help, :q to quit) -------}+\end{tabbing}+The line of output is highlighted\footnote{+In the printed version of this tutorial, highlighted text or+expressions are shown boxed; the Hat tools actually use colour for+highlighting.}+because it is the current selection.++Requests in {\tt hat-trail} are of two kinds. Some are single key presses+with an immediate response; others are command-lines starting with+a colon and only acted upon when completed by keying return.+A basic repertoire of single-key requests is:+\begin{center}+\begin{tabular*}{\textwidth}{lp{10cm}}+{\em return}      & add to the trail the parent expression of+                    the current selection \\+{\em backspace}   & remove the last addition to the trail display \\+{\em arrow keys}  & select (a) parts of the output generated by+                    different actions, or (b) subexpressions of expressions+	            already on display+\end{tabular*}+\end{center}+And a basic repertoire of command-line requests is:+\begin{center}+\begin{tabular*}{\textwidth}{lp{10cm}}+{\tt :source} & show the source expression of which the current+                selection is an instance \\+{\tt :quit}   & finish this hat-trail session+\end{tabular*}+\end{center}+It is enough to give initial letters, {\tt :s} or {\tt :q}, rather+than {\tt :source} or {\tt :quit}.++\subsubsection*{Some {\tt Insort} trails}+To trace the output from the {\tt Insort} computation, keying return+alters the {\tt Trail} part of the display to:+\begin{tabbing}+{\tt Trail:\ ----------------------- Insort.hs line:\ 10 col:\ 8 ------} \\+{\tt <- }\highlight{putStrLn "agmoprr"}+\end{tabbing}+The source reference is to the corresponding application of {\tt putStrLn} in+the program.  Giving the command {\tt :s} at this point creates a separate+source window showing the relevant extract of the program.\footnote{+The only+thing to do with a source extract is to look at it: tracing with Hat+does not involve annotating or otherwise modifying program sources.}++Back to the {\tt Trail} display. Keying return again:+\begin{tabbing}+{\tt Trail:\ ----------------------- Insort.hs line:\ 10 col:\ 1 ------} \\+{\tt <-}\highlight{putStrLn "agmoprr"} \\+{\tt <-}\highlight{main}+\end{tabbing}+That is, the line of output was produced by an application of+{\tt putStrLn} occurring in the body of {\tt main}.++So far, so good; but what about the sorting?  How do we see where {\tt putStr}'s+string argument {\tt "agmoprr"} came from?  By making that string the current+selection and requesting its parent:+\begin{tabbing}+{\em right-arrow}\hspace{10mm}\=\kill+{\em backspace}   \> (removes {\tt main}), \\+{\em right-arrow} \> (selects {\tt putStrLn}), \\+{\em right-arrow} \> (selects {\tt "agmoprr"}), \\+{\em return}      \> (requests parent expression)+\end{tabbing}+\begin{tabbing}+{\tt Trail:\ ----------------------- Insort.hs line:\ 7 col:\ 19 -----} \\+{\tt <- putStrLn\ }\highlight{"agmoprr"} \\+{\tt <-\ }\highlight{insert 'p' "agmorr" | if False}+\end{tabbing}+The string {\tt "agmoprr"} is the result of inserting {\tt 'p'}, the head of the+string {\tt "program"}, into the recursively sorted tail.  More specifically,+the string was computed in the else-branch of the conditional by which+{\tt insert} is defined in the recursive case+(because {\tt 'p' <= 'a'} is {\tt False}).++And so we could continue.  For example, following the trail of+string arguments:+\begin{tabbing}+{\tt <- insert 'p'\ }\highlight{"agmorr"}{\tt \ | if False} \\+{\tt <- insert 'r'\ }\highlight{"agmor"}{\tt \ | if False} \\+{\tt <- insert 'o'\ }\highlight{"agmr"}{\tt \ | if False} \\+{\tt <- insert 'g'\ }\highlight{"amr"}{\tt \ | if False} \\+{\tt <- insert 'r'\ }\highlight{"am"}{\tt \ | if False} \\+{\tt <- insert 'a'\ }\highlight{"m"}{\tt \ | if True} \\+{\tt <-\ }\highlight{insert 'm' []}+\end{tabbing}+But let's leave hat-trail for now.+\begin{tabbing}+{\tt :quit} \\+\end{tabbing}++\section{Hat-observe: Basics}+The idea of hat-observe is to answer the question `To which arguments,+if any, was that applied, and with what results?', mainly in relation+to a top-level function.+Answers take the form of a list of equational observations, showing+for each application of the function to distinct arguments what result+was computed.  The user has the option to limit observations to particular+patterns of arguments or results, or to particular application contexts. ++\subsubsection*{Hat-observe sessions and requests}+A hat-observe session can be started from a shell command line, or from+within existing sessions of hat tools.+\begin{tabbing}+{\tt \$ hat-observe Insort} \\ \\+{\tt \ \ \ \ \ \ \ \ hat-observe 2.00  (:h for help, :q to quit)} \\ \\+{\tt hat-observe>} \\+\end{tabbing}+In comparison with hat-trail, there is more emphasis on command-lines+in hat-observe,+and the main user interface is a prompt-request-response+cycle.+Requests are of two kinds.+Some are observation queries in the+form of application patterns:+the simplest observation query is just the name of a top-level function.+Others are command-lines, starting with+a colon, similar to those of hat-trail.+A basic repertoire of command-line requests is+\begin{center}+\begin{tabular*}{\textwidth}{lp{10cm}}+{\tt :info } & list the names of functions and other defined+               values that can be observed, with application counts \\+{\tt :quit}  & finish this hat-observe session \\+\end{tabular*}+\end{center}+Again it is enough to give the initial letters, {\tt :i} or {\tt :q}.+\subsubsection*{Some {\tt Insort} observations}+A common way to begin a hat-observe session is with an {\tt :info}+request, followed by initial observation of central functions.+\begin{tabbing}+{\tt hat-observe> :info} \\+\hspace{2.5cm}\=\hspace{2.5cm}\=\hspace{2.5cm}\=\hspace{2.5cm}\=\kill+{\tt 19 <=}       \> {\tt 21 insert}        \> {\tt 1 main}   \>+{\tt 1 putStrLn}  \> {\tt 1 sort} \\+{\tt hat-observe> sort} \\+{\tt \mkblue{1} sort "program" = "agmoprr"} \\+{\tt \mkblue{2} sort "rogram" = "agmorr"} \\+{\tt \mkblue{3} sort "ogram" = "agmor"} \\+{\tt \mkblue{4} sort "gram" = "agmr"} \\+{\tt \mkblue{5} sort "ram" = "amr"} \\+{\tt \mkblue{6} sort "am" = "am"} \\+{\tt \mkblue{7} sort "m" = "m"} \\+{\tt \mkblue{8} sort [] = []}+\end{tabbing}+Here the number of observations is small.  Larger collections of+obervations are presented in blocks of ten (by default).+\begin{tabbing}+{\tt hat-observe> <=} \\+{\tt \mkblue{1} 'a' <= 'm' = True} \\+{\tt \mkblue{2} 'r' <= 'a' = False} \\+{\tt \mkblue{3} 'g' <= 'a' = False} \\+{\tt \mkblue{4} 'o' <= 'a' = False} \\+{\tt \mkblue{5} 'p' <= 'a' = False} \\+{\tt \mkblue{6} 'r' <= 'm' = False} \\+{\tt \mkblue{7} 'g' <= 'm' = True} \\+{\tt \mkblue{8} 'o' <= 'g' = False} \\+{\tt \mkblue{9} 'r' <= 'g' = False} \\+{\tt \mkblue{10} 'p' <= 'g' = False} \\+{\tt --more--> }+\end{tabbing}+Keying return in response to {\tt --more-->} requests the next block of+observations.  Alternatively, requests in the colon-command family can+be given.  Any other line of input cuts+short the list of reported observations in favour of a fresh {\tt hat-observe>}+prompt.+\begin{tabbing}+{\tt --more--> n} \\+{\tt hat-observe>}+\end{tabbing}++\subsubsection*{Observing restricted patterns of applications}+Viewing a block at a time is not the only way of handling what may be+a large number of applications.  Obervations can also be restricted to+applications in which specific patterns of values occur as arguments or result, or+to applications in a specific context.  The full syntax for obervation+queries is+\begin{tabbing}+{\tt identifier pattern* [= pattern] [in identifier]}+\end{tabbing}+where the {\tt *} indicates that there can be zero or more occurrences of+an argument pattern and the {\tt [...]} indicate that the result pattern and+context are optional.  Patterns in observation queries are simplified+versions of constructor patterns with \verb"_" as the only variable.+Some examples for the {\tt Insort} computation:+\begin{tabbing}+{\tt hat-observe> insert 'g' \verb"_"} \\+{\tt \mkblue{1} insert 'g' "amr" = "agmr"} \\+{\tt \mkblue{2} insert 'g' "mr" = "gmr"} \\+{\tt hat-observe> insert \verb"_" \verb"_" = [\verb"_"]} \\+{\tt \mkblue{1} insert 'm' [] = "m"} \\+{\tt \mkblue{2} insert 'r' [] = "r"} \\+{\tt hat-observe> sort in main} \\+{\tt \mkblue{1} sort "program" = "agmoprr"} \\+{\tt hat-observe> sort in sort} \\+{\tt \mkblue{1} sort "rogram" = "agmorr"} \\+{\tt \mkblue{2} sort "ogram" = "agmor"} \\+{\tt \mkblue{3} sort "gram" = "agmr"} \\+{\tt \mkblue{4} sort "ram" = "amr"} \\+{\tt \mkblue{5} sort "am" = "am"} \\+{\tt \mkblue{6} sort "m" = "m"} \\+{\tt \mkblue{7} sort [] = []}+\end{tabbing}+Enough on hat-observe for now.+\begin{tabbing}+{\tt hat-observe> :quit}+\end{tabbing}++\section{Tracing Faulty Programs}++We have seen so far some of the ways in which Hat tools can be used+to trace a correctly working program.  But a common and intended use+for Hat is to trace a faulty program with the aim of locating the+source of the faults.  A faulty computation has one of three outcomes:+\begin{enumerate}+\item+termination with a run-time error, or+\item+termination with incorrect output, or+\item+non-termination.+\end{enumerate}+A variant of {\tt Insort}+given\footnote{The program may also be found in the file {\tt BadInsort.hs}.}+in Figure~\ref{badinsort} has three faults,+each of which alone+would cause a different outcome, as indicated by comments.+\begin{figure}[t]+\fbox{\parbox{\textwidth}{+\begin{tabular}{lcl}+\multicolumn{3}{l}{\tt sort ::\ Ord a => [a] -> [a]} \\+\multicolumn{3}{l}{\tt -- FAULT (1):\ missing equation for [] argument} \\+{\tt sort (x:xs)} & {\tt =} & {\tt insert x (sort xs)}+\end{tabular} \\+\begin{tabular}{lcl}+\multicolumn{3}{l}{\tt insert ::\ Ord a => a -> [a] -> [a]} \\+{\tt insert x []}     & {\tt =} & {\tt [x]} \\+{\tt insert x (y:ys)} & {\tt =} & {\tt if x <= y} \\+                      &         & {\tt -- FAULT (2):\ y missing from result} \\+                      &         & {\tt then x : ys} \\+                      &         & {\tt -- FAULT (3):\ recursive call is same} \\+                      &         & {\tt else y :\ insert x (y:ys)}+\end{tabular} \\+\begin{tabular}{lcl}+{\tt main} & {\tt =} & {\tt putStrLn (sort "program")}+\end{tabular}+}}+\caption{\label{badinsort}A faulty version of the insertion-sort program.}+\end{figure}+In the following sections we shall apply the Hat tools to examine the+faulty program, as if we didn't know in advance where the faults were.++\subsection{Tracing a Run-time Error}+We compile the faulty program for tracing, then run it:+\begin{tabbing}+{\tt \$ hmake -hat BadInsort} \\+{\tt ...} \\+{\tt \$ BadInsort } \\+{\tt No match in pattern. }+\end{tabbing}+Two questions prompted by this error message are:+\begin{itemize}+\item+What was the application that didn't match?+\item+Where did that application come from?+\end{itemize}++\subsubsection*{Using hat-trail}++Both questions can be answered by using hat-trail to trace the derivation+of the error. +\begin{tabbing}+{\tt \$ hat-trail BadInsort} \\+\\+{\tt Error:\ --------------------------------------------------------} \\+\highlight{No match in pattern.} \\+\end{tabbing}+Keying return once to see the erroneous application,+then again to see its parent application:+\begin{tabbing}+{\tt Trail:\ ------------------- BadInsort.hs line:\ 3 col:\ 25 -------} \\+{\tt <-\ }\highlight{sort []} \\+{\tt <-\ }\highlight{sort "m"}+\end{tabbing}+This information can be supplemented by reference to the source program.+With {\tt sort []} selected, the {\tt :source} command+shows the site of the offending application in the+recursive equation for {\tt sort}.+If necessary the ancestry of the {\tt []} argument or+the {\tt sort} application could be traced back further\footnote{+In general, when+tracing the origins of an application there are five choices: trace the+ancestry of the function, or of an argument, or of the application itself;+alternatively look at the source context of the application, or at the+source definition of the function}.+% For example, selecting+% the {\tt []} argument (right-arrow twice) shows its origin to be the string+% literal {\tt "program"} in {\tt main}.++\subsubsection*{Using hat-observe}++Although hat-trail is usually the first resort for tracing run-time+errors, it is instructive to see what happens if instead we try+using hat-observe.+\begin{tabbing}+{\tt \$ hat-observe BadInsort } \\ \\+{\tt \ \ \ \ \ \ \ \ hat-observe 2.00  (:h for help, :q to quit)} \\ \\+\hspace{2.5cm}\=\hspace{2.5cm}\=\hspace{2.5cm}\=\hspace{2.5cm}\=\kill+{\tt hat-observe> :info } \\+{\tt 7+0 insert} \> {\tt 1 main} \> {\tt 1 putStrLn} \> {\tt 1+7 sort}+\end{tabbing}+What do the {\it M}{\tt +}{\it N} counts for {\tt insert} and {\tt sort}+mean?  {\it M} is the number of applications that never got+beyond a pattern-matching stage involving evaluation of arguments;+{\it N} is the number of applications that were actually reduced+to an instance of the function body.+Applications are only counted at all if their results were+demanded during the computation.+Where a count is shown as a single number, it is a count of applications+actually reduced.++In the {\tt BadInsort} computation, we see +there are fewer obervations of {\tt insert} than there were+in the correct {\tt Insort}+computation, and no observations at all+of {\tt <=}.  How can that be?  What is happening+to ordered insertion?+\begin{tabbing}+{\tt hat-observe> insert }\\+{\tt \mkblue{1} insert 'p' \verb"_|_" = \verb"_|_" }\\+{\tt \mkblue{2} insert 'r' \verb"_|_" = \verb"_|_" }\\+{\tt \mkblue{3} insert 'o' \verb"_|_" = \verb"_|_" }\\+{\tt \mkblue{4} insert 'g' \verb"_|_" = \verb"_|_" }\\+{\tt \mkblue{5} insert 'a' \verb"_|_" = \verb"_|_" }\\+{\tt \mkblue{6} insert 'm' \verb"_|_" = \verb"_|_" }+\end{tabbing}+The symbol \verb"_|_" here indicates an undefined value.  Reading the character+arguments vertically {\tt "program"} seems to be misspelt: is there an observation+missing between {\tt 4} and {\tt 5}?  There are in fact two separate applications+{\tt insert 'r' \verb"_|_" = \verb"_|_"}, but duplicate observations are not listed (by default).++The {\tt insert} observations explain the fall in application counts.+In all the observed applications, the list arguments are undefined.+So neither of the defining equations for {\tt insert} is ever matched, +there are no {\tt <=} comparisons (as these occur only in the right-hand+side of the second equation) and of course no recursive+calls.++Why are the {\tt insert} arguments undefined?  They should be the results of+{\tt sort} applications.+\begin{tabbing}+{\tt hat-observe> sort } \\+{\tt \mkblue{1} sort "program" = \verb"_|_" } \\+{\tt \mkblue{2} sort "rogram" = \verb"_|_" } \\+{\tt \mkblue{3} sort "ogram" = \verb"_|_" } \\+{\tt \mkblue{4} sort "gram" = \verb"_|_" } \\+{\tt \mkblue{5} sort "ram" = \verb"_|_" } \\+{\tt \mkblue{6} sort "am" = \verb"_|_" } \\+{\tt \mkblue{7} sort "m" = \verb"_|_" } \\+{\tt \mkblue{8} sort [] = \verb"_|_" }+\end{tabbing}+Observations {\tt 1} to {\tt 7} show applications of sort that+reduced to applications of {\tt insert}, with the {\tt \verb"_|_"} results+already observed\footnote{This insight requires independent knowledge+of the program, however,+as hat-observe, unlike hat-trail, is not concerned with+relationships between applications.}.+Observation {\tt 8} is the application that does not reduce.++In short, the story so far from hat-observe is quite simple: everything+is undefined!  What about the other two items in the+info list, {\tt putStrLn} and {\tt main}?+\begin{tabbing}+{\tt hat-observe> putStrLn } \\+{\tt \mkblue{1} putStrLn \verb"_|_" = \{IO\}} \\+{\tt hat-observe> main } \\+{\tt \mkblue{1} main = \{IO\}}+\end{tabbing}+Hat uses symbols enclosed in braces, such as {\tt \{IO\}} here,+to indicate values that cannot be shown more explicitly.+These observations only confirm that the program does compute+an I/O action, but the output string is undefined.++\subsection{Tracing a Non-terminating Computation}+Suppose we correct the first fault, by restoring the equation+\begin{tabbing}+{\tt sort [] = []}+\end{tabbing}+and recompile.  Now the result of running {\tt BadInsort} is a non-terminating+computation, with an infinite string {\tt aaaaaaa...} as output. It seems+that {\tt BadInsort} has entered an infinite loop. The computation can be+interrupted\footnote{When non-termination is suspected,+interrupt as quickly as possible to+avoid working with very large traces.}+by keying control-C.+\begin{tabbing}+{\tt \$ BadInsort } \\+{\tt Program interrupted.\ (\symbol{94}C)} \\+{\tt aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\$ } \\+\end{tabbing}+Questions this time include:+\begin{itemize}+\item+What parts of the program does the infinite loop involve?+\item+How did it come about in the first place?+\end{itemize}++\subsubsection*{Using hat-trail}+The initial hat-trail display is:+\begin{tabbing}+{\tt Error:\ -------------------------------------------------------- } \\+\highlight{Program interrupted.\ (\symbol{94}C)} \\+{\tt Output:\ ------------------------------------------------------- } \\+{\tt aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa... } \\+\end{tabbing}+We have a choice: we can follow the trail back either from the point+of interruption (the initial selection) or from the output (reached by+down-arrow).  In this case, it makes little difference\footnote{However,+the trace from point of interruption depends+on the timing of the interrupt.};+either way we+end up examining the endless list of {\tt 'a'}s.  Let's select the output:+\begin{tabbing}+{\tt Output:\ ------------------------------------------------------- } \\+\highlight{aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...} \\+{\tt Trail:\ -----------------  BadInsort.hs line:\ 7 col:\ 19 -------- } \\+{\tt <- putStrLn\ }\highlight{"aaaaaaaa..."} \\+{\tt <-\ }\highlight{insert 'p' ('a':\_) | if False}+\end{tabbing}+Notice two further features of expression display:+\begin{itemize}+\item+the ellipsis {\tt ...} in the string argument to {\tt putStrLn} indicates+the tail-end of a long string that has been pruned from the display+\footnote{In other contexts where large expressions have to be+pruned the symbol \CUT is used as a place-holder for components.};+\item+the symbol {\tt \verb"_"} in the list argument to {\tt insert} indicates an expression+that was never evaluated.+\end{itemize}+The parent application {\tt insert 'p' ('a':\verb"_") | if False} gives several+important clues.+It tells us that in the else-branch of the recursive case in the+definition of {\tt insert} the argument's head (here {\tt 'a'}) is duplicated+endlessly to generate the result without ever demanding the argument's+tail (shown only as \verb"_").  This should be enough explanation to discover+the fault if we didn't already know it.++\subsubsection*{Using hat-observe}+Once again, let's also see what happens if we use hat-observe.+\begin{tabbing}+\hspace{2.5cm}\=\hspace{2.5cm}\=\hspace{2.5cm}\=\hspace{2.5cm}\=\kill+{\tt hat-observe> :info } \\+{\tt 78 <=}       \> {\tt 1+83 insert}    \>  {\tt 1 main} \>+{\tt 1 putStrLn} \> {\tt 8 sort} \\+\end{tabbing}+All the expected items are listed as observable. The abnormal counts for+{\tt <=} and {\tt insert} already give a strong clue where to look.+But let's first consider the other functions.+We know well+enough from the overall output what {\tt main} and {\tt putStrLn} are doing,+but what about {\tt sort}? Its application count is perfect, but what can+we glean from details of the arguments and results?+\begin{tabbing}+{\tt hat-observe> sort } \\+{\tt \mkblue{1} sort "program" = "aaaaaaaaaa..." } \\+{\tt \mkblue{2} sort "rogram" = 'a':\verb"_" } \\+{\tt \mkblue{3} sort "ogram" = 'a':\verb"_" } \\+{\tt \mkblue{4} sort "gram" = 'a':\verb"_" } \\+{\tt \mkblue{5} sort "ram" = 'a':\verb"_" } \\+{\tt \mkblue{6} sort "am" = "a" } \\+{\tt \mkblue{7} sort "m" = "m" } \\+{\tt \mkblue{8} sort [] = [] }+\end{tabbing}+Observations 1 to 5 tell a similar story to hat-trail: the tails+of the recursively computed lists are never demanded; at the+outermost level, the head is repeated endlessly.+Observation 6 points to a problem other than non-termination,+but we shall ignore that for now.  Observations+7 and 8 do not point to a problem at all.++There is one further clue in these observations: the arguments decrease+just as expected, confirming that the recursive loop must be+in {\tt insert}.+\begin{tabbing}+{\tt hat-observe> insert } \\+{\tt \mkblue{1} insert 'p' ('a':\verb"_") = "aaaaaaaaaa..." } \\+{\tt \mkblue{2} insert 'r' ('a':\verb"_") = 'a':\verb"_" } \\+{\tt \mkblue{3} insert 'o' ('a':\verb"_") = 'a':\verb"_" } \\+{\tt \mkblue{4} insert 'g' ('a':\verb"_") = 'a':\verb"_" } \\+{\tt \mkblue{5} insert 'a' "m" = "a" } \\+{\tt \mkblue{6} insert 'm' [] = "m" } \\+{\tt searching ... (\symbol{94}C to interrupt) } \\+{\tt \{Interrupted\} }+\end{tabbing}+Many more observations would eventually be reported because+hat-observe lists each observation that is distinct from+% , or more+% general than\footnote{+% Application A is more general+% than application B if their arguments and results agree where both+% are evaluated but A's arguments are less evaluated than B's or A's+% result is more evaluated than B's.},+those listed previously.+When the computation is interrupted+there are many different applications of the form {\tt insert 'p' ('a':\verb"_")}+in progress, each with results evaluated to a different extent.++But observation 1 is enough. As the tail of the argument is+unevaluated, the result would be the same whatever the tail.+For example, it could be {\tt []}; so we know+{\tt insert 'p' "a" = "aaaa..."}.+This specific and simple+failing case directs us to the fault in the definition+of {\tt insert}.++\subsection{Tracing Wrong Output}++Let's now correct the recursive call from {\tt insert x (y:ys)} to+{\tt insert x ys}, recompile, then execute.+\begin{tabbing}+{\tt \$ BadInsort } \\+{\tt agop } \\+\end{tabbing}++\subsubsection*{Using hat-observe}+Once again, we could reach first for hat-trail to trace the fault,+but the availability of a well-defined (but wrong) result also+suggests a possible starting point in hat-observe:+\begin{tabbing}+{\tt hat-observe> insert \verb"_" \verb"_" = "agop" } \\+{\tt \mkblue{1} insert 'p' "agor" = "agop" }+\end{tabbing}+Somehow, insertion loses the final element {\tt 'r'}.+Perhaps we'd like to see more details of how this result is obtained ---+the relevant recursive calls, for example:+\begin{tabbing}+{\tt hat-observe> insert 'p' \verb"_" in insert } \\+{\tt \mkblue{1} insert 'p' "gor" = "gop" } \\+{\tt \mkblue{2} insert 'p' "or" = "op" } \\+{\tt \mkblue{3} insert 'p' "r" = "p" }+\end{tabbing}+Observation 3 makes it easy to discover the fault by inspection.++\subsubsection*{Using hat-trail}++If we instead use hat-trail, the same application could be reached+as follows. We first request the parent of the output; unsurprisingly+it is {\tt putStrLn "agop"}.  We then request the parent of the string+argument {\tt "agop"}:+\begin{tabbing}+{\tt Output:\ ------------------------------------------------------ } \\+\highlight{agop\char92n} \\+{\tt  } \\+{\tt Trail:\ ----------------- BadInsort.hs line:\ 10 col:\ 26 ------- } \\+{\tt <- putStrLn\ }\highlight{"agop"} \\+{\tt <-\ }\highlight{insert 'p' "agor" | if False} \\+\end{tabbing}+As in hat-observe, we see the {\tt insert} application that loses+the character {\tt 'r'}.+\begin{center}+{\large({\em To be continued.})}+\end{center}++\end{document}
+ hat.cabal view
@@ -0,0 +1,228 @@++name:                hat+version:             2.7.0.0+synopsis:            The Haskell tracer, generating and viewing Haskell execution traces+description:+  hat-trans transforms Module.hs into Hat/Module.hs such that when the program is+  executed, a trace file Programname.hat is generated.+  Various tools (hat-trail, hat-observe, hat-explore ...) then allow viewing the +  trace file in different ways, to locate a bug or understand how a program works.++  This is the first release of Hat under Cabal.++  It is the least possible update to make Hat work with Cabal.+  Hat 2.07 works only with ghc for Haskell 98 (plus a few extensions) and+  the standard Haskell 98 libraries. Although it should build on any operating system,+  most viewing tools use ASCII console escape sequences and they open xterms;+  hence they will only work well under Unix and X11.++  Installation:++  > cabal -v install (--user | --global)++  Flag -v allows you to see what is going on. Building takes a long time +  (one module has 25.000 lines of code). Don't worry about numerous warning messages.++  Use:++  > hat-make MyProgram.hs++  transforms and compiles all modules of your program and produces the tracing+  version Hat/MyProgram.++  Run your program +  > Hat/MyProgram+  which will produce trace files MyProgram.hat*++  Use the viewing tools to explore the trace:++  > hat-trail / hat-observe / hat-explore /...   MyProgram++  There is documentation in the "docs" folder, but much of it is outdated.+homepage:            http://www.cs.kent.ac.uk/~oc+license:             OtherLicense+license-file:        docs/copyright.html+copyright:	     (c) 2000-2012 Hat team+author:              Hat team+maintainer:          oc@kent.ac.uk+stability:	     provisional+tested-with:	     GHC ==7.4.1+bug-reports:	     oc@kent.ac.uk   +category:            Development+build-type:          Simple+cabal-version:       >=1.8++data-dir:	     libhx+data-files:	     *.hx+extra-source-files:  include/*.h, tools/*.h, libraries/*.hs, docs/*.html, docs/*.hs, docs/*.ps.gz, docs/*.eps, docs/*.gif, docs/*.pdf, docs/*.tex, docs/*.dvi, docs/*.hva, docs/man/*.1, docs/man/*.1.in++source-repository head+  type:		     git+  location:	     git://github.com/OlafChitil/hat.git++library+  exposed-modules:     Hat.Array, Hat.Char, Hat.Complex, Hat.CPUTime, Hat.Directory, Hat.Hack, Hat.Hat, Hat.IO, Hat.Ix, Hat.List, Hat.Locale, Hat.Maybe, Hat.Monad, Hat.Numeric, Hat.Prelude, Hat.PreludeBasic, Hat.Random, Hat.Ratio, Hat.System, Hat.Time+  build-depends:       base ==4.5.*, directory ==1.1.*, random ==1.0.*, process ==1.1.*, old-time ==1.1.*, old-locale ==1.0.*+  other-modules:       Hat.DirectoryBuiltin, Hat.DirectoryBuiltinTypes, Hat.IOBuiltin, Hat.IOBuiltinTypes, Hat.PreludeBuiltin, Hat.PreludeBuiltinTypes, Hat.RandomBuiltin, Hat.SystemBuiltin, Hat.SystemBuiltinTypes, Hat.TimeBuiltin, Hat.TimeBuiltinTypes+  extensions:	       ForeignFunctionInterface+  includes:	       hat-c.h, art.h, ntohl.h+  include-dirs:	       include, Hat+  c-sources:	       Hat/hat-c.c+  cc-options:	       -DFILEVERSION="2.07"++executable hat-trans+  main-is:           HatTrans.hs+  hs-source-dirs:    trans, compiler98+  other-modules:     TraceDerive, AuxLabelAST, AuxFixity, AuxFile, AuxTypes, TraceId, Flags, PrettyTraceId, HatTrans, Wrapper, AssocTree, Error, Extra, HbcOnly, Id, IdKind, Info, IntState, Lex, LexLow, LexPre, LexStr, Lexical, MergeSort, MkSyntax, NT, Nice, OsOnly, Parse, Parse2, ParseCore, ParseLex, ParseLib, PrettyLib, PrettySyntax, Reduce, Syntax, SyntaxPos, SyntaxUtil, SysDeps, TokenId, Tree234, Unlit, Paths_hat+  build-depends:     base ==4.5.*, bytestring ==0.9.*, directory ==1.1.*+  includes:	     hat-c.h, art.h, ntohl.h+  include-dirs:	     include, Hat+  c-sources:	     Hat/hat-c.c+  cc-options:        -DFILEVERSION="2.07" -DVERSION="2.07"++executable hat-trail+  main-is:           HatTrail.hs+  hs-source-dirs:    tools        +  other-modules:     LowLevel, SrcRef, Ident, SExp, PrettyLibHighlight, Highlightstyle, CommonUI+  build-depends:     base ==4.5.*, containers ==0.4.*, directory ==1.1.*, process ==1.1.*+  extensions:        ForeignFunctionInterface+  includes:          art.h+  include-dirs:      include+  c-sources:         tools/pathutils.c, tools/artutils.c, tools/finitemap.c+  cc-options:        -DFILEVERSION="2.07" -DVERSION="2.07"++executable hat-observe+  main-is:           HatObserve.hs+  hs-source-dirs:    tools+  other-modules:     Observe, LowLevel, SExp, Ident, PrettyLibHighlight, HighlightStyle, Pattern, ParseLib, Idents, CmdLine, CommonUI, SrcRef, Trie, TExp+  build-depends:     base ==4.5.*, process ==1.1.*, haskeline >=0.6+  extensions:        ForeignFunctionInterface+  includes:          art.h+  include-dirs:      include+  c-sources:         tools/pathutils.c, tools/artutils.c, tools/finitemap.c, tools/hat-names.c, tools/observeutils.c+  cc-options:        -DFILEVERSION="2.07" -DVERSION="2.07"+ +executable hat-stack+  main-is:           HatStackText.hs+  hs-source-dirs:    tools+  other-modules:     HatStack, LowLevel, SExp, PrettyLibHighlight, HighlightStyle, Ident, SrcRef, CommonUI+  build-depends:     base ==4.5.*, process ==1.1.*+  extensions:	     ForeignFunctionInterface+  includes:	     art.h+  include-dirs:	     include+  c-sources:	     tools/pathutils.c, tools/artutils.c, tools/finitemap.c+  cc-options:        -DFILEVERSION="2.07" -DVERSION="2.07"+ +executable hat-explore+  main-is:           HatExplore.hs+  hs-source-dirs:    tools+  other-modules:     Explore, CommonUI, HighlightStyle, LowLevel, Ident, SrcRef, SExp, Detect, NodeExp, Slice, ADT, Detect, PrettyLibHighlight+  build-depends:     base ==4.5.*, process ==1.1.*+  extensions:	     ForeignFunctionInterface+  includes:	     art.h+  include-dirs:	     include+  c-sources:	     tools/parentset.c, tools/detectutils.c, tools/pathutils.c, tools/artutils.c, tools/finitemap.c+  cc-options:        -DFILEVERSION="2.07" -DVERSION="2.07"++executable hat-detect+  -- currently just calls hat-delta; was a separate tool+  main-is:	     HatDetect.hs+  hs-source-dirs:    tools+  other-modules:     Pretty, Slice, LowLevel, CommonUI, NodeExp, SExp, ADT, EDT, SrcRef, FDT, Detect, Explore, HighlightStyle, PrettyLibHighlight, Ident+  build-depends:     base ==4.5.*, process ==1.1.*, containers ==0.4.*+  extensions:	     ForeignFunctionInterface+  includes:	     art.h, ntohl.h+  include-dirs:	     include+  c-sources:	     tools/detectutils.c, tools/parentset.c, tools/pathutils.c, tools/artutils.c, tools/finitemap.c+  cc-options:        -DFILEVERSION="2.07" -DVERSION="2.07"++executable hat-check+  main-is:	     HatCheck.hs+  hs-source-dirs:    tools+  build-depends:     base ==4.5.*, process ==1.1.*+  extensions:	     ForeignFunctionInterface+  includes:	     art.h, ntohl.h+  include-dirs:	     include+  c-sources:	     tools/hat-check.c+  cc-options:        -DFILEVERSION="2.07" -DVERSION="2.07"++executable hat-view+  main-is:	     SrcRefViewer.hs+  hs-source-dirs:    tools+  other-modules:     HighlightStyle, Run+  build-depends:     base ==4.5.*, process ==1.1.*, directory ==1.1.*+  extensions:	     ForeignFunctionInterface+  includes:	     art.h, ntohl.h+  include-dirs:	     include++executable hat-cover+  -- builds, but doesn't seem to work+  main-is:	     HatCoverText.hs+  hs-source-dirs:    tools+  other-modules:     HatCover, LowLevel, SrcRef, HighlightStyle+  build-depends:     base ==4.5.*, process ==1.1.*+  extensions:	     ForeignFunctionInterface+  includes:	     art.h, ntohl.h+  include-dirs:	     include+  c-sources:	     tools/pathutils.c, tools/artutils.c, tools/finitemap.c+  cc-options:        -DFILEVERSION="2.07" -DVERSION="2.07"++executable black-hat+  main-is:	     BlackHat.hs+  hs-source-dirs:    tools+  other-modules:     LowLevel, Sexp, PrettyLibHighlight, Highlightstyle, Run, NonTermLib+  build-depends:     base ==4.5.*, process ==1.1.*+  extensions:	     ForeignFunctionInterface+  includes:	     art.h, ntohl.h+  include-dirs:	     include+  c-sources:	     tools/nontermutils.c, tools/pathutils.c, tools/artutils.c, tools/finitemap.c+  cc-options:        -DFILEVERSION="2.07" -DVERSION="2.07"++executable hat-nonterm+  main-is:	     HatNonTerm.hs+  hs-source-dirs:    tools+  other-modules:     LowLevel, Sexp, PrettyLibHighlight, Highlightstyle, Run, NonTermLib+  build-depends:     base ==4.5.*, process ==1.1.*+  extensions:	     ForeignFunctionInterface+  includes:	     art.h, ntohl.h+  include-dirs:	     include+  c-sources:	     tools/nontermutils.c, tools/pathutils.c, tools/artutils.c, tools/finitemap.c+  cc-options:        -DFILEVERSION="2.07" -DVERSION="2.07"++executable hat-anim+  main-is:	     HatAnim.hs+  hs-source-dirs:    tools+  other-modules:     NodeExp, Pretty, CommonUI, LowLevel, HighlightStyle+  build-depends:     base ==4.5.*, process ==1.1.*, containers ==0.4.*+  extensions:	     ForeignFunctionInterface+  includes:	     art.h, ntohl.h+  include-dirs:	     include+  c-sources:	     tools/detectutils.c, tools/parentset.c, tools/pathutils.c, tools/artutils.c, tools/finitemap.c+  cc-options:        -DFILEVERSION="2.07" -DVERSION="2.07"++executable pretty-hat+  main-is:	     PrettyHat.hs+  hs-source-dirs:    tools+  other-modules:     Pretty, NodeExp, EDT, HighlightStyle, Detect, Slice, ADT, Explore, SExp, CommonUI, SrcRef, Ident, LowLevel, PrettyLibHighlight+  build-depends:     base ==4.5.*, process ==1.1.*, containers ==0.4.*+  extensions:	     ForeignFunctionInterface+  includes:	     art.h, ntohl.h+  include-dirs:	     include+  c-sources:	     tools/detectutils.c, tools/parentset.c, tools/pathutils.c, tools/artutils.c, tools/finitemap.c+  cc-options:        -DFILEVERSION="2.07" -DVERSION="2.07"++executable hat-delta+  main-is:	     HatDelta.hs+  hs-source-dirs:    tools+  other-modules:     Pretty, Slice, LowLevel, CommonUI, NodeExp, SExp, ADT, EDT, SrcRef, FDT, Detect, Explore, HighlightStyle, PrettyLibHighlight, Ident+  build-depends:     base ==4.5.*, process ==1.1.*, containers ==0.4.*+  extensions:	     ForeignFunctionInterface+  includes:	     art.h, ntohl.h+  include-dirs:	     include+  c-sources:	     tools/detectutils.c, tools/parentset.c, tools/pathutils.c, tools/artutils.c, tools/finitemap.c+  cc-options:        -DFILEVERSION="2.07" -DVERSION="2.07"++executable hat-make+  main-is:	     HatMake.hs+  hs-source-dirs:    tools+  build-depends:     base ==4.5.*, process ==1.1.*, directory ==1.1.*
+ include/art.h view
@@ -0,0 +1,80 @@+#ifndef _ART_H+#define _ART_H++#include <stdint.h>++/* FileOffset is just a byte-pointer into the file.+ * There are four distinguished values that are otherwise not valid pointers.+ */+typedef uint32_t FileOffset;+#define Root            0x0+#define Unevaluated     0x1+#define Entered         0x2+#define Interrupted     0x3+#define Lambda          0x4+#define DoLambda        0x5++/* A tag byte has four interior fields:+ * 7    | 6    | 5    | 4    3    2    1    0+ * free | src? | bool |  tag value          |+ */++/* bit 6 indicates whether there is a SrcPos for the use-position of an expr */+#define HasSrcPos	0x40+#define hasSrcPos(x)  ((x)&HasSrcPos)++/* bit 5 holds a boolean which is used for various purposes in different exps */+#define IsEntered	0x20+#define LocalDef	0x20+#define HasFields	0x20+#define TracedModule	0x20+#define isEntered(x)	((x)&isEntered)+#define localDef(x)	((x)&LocalDef)+#define hasFields(x)	((x)&HasFields)+#define tracedModule(x)	((x)&TracedModule)++/* Tag values: the lower 5 bits of the tag byte */+#define lower5(x)       ((x)&0x1f)++#define Module          0x00+#define SrcPos          0x01++#define ExpApp          0x02+#define ExpValueApp     0x03+#define ExpChar         0x04+#define ExpInt          0x05+#define ExpInteger      0x06+#define ExpRat          0x07+#define ExpRational     0x08+#define ExpFloat        0x09+#define ExpDouble       0x0a+#define ExpValueUse     0x0b+#define ExpConstUse     0x0c+#define ExpConstDef     0x0d+#define ExpGuard        0x0e+#define ExpCase         0x0f+#define ExpIf           0x10+#define ExpFieldUpdate  0x11+#define ExpProjection   0x12+#define ExpHidden       0x13+#define ExpForward      0x14+#define ExpDoStmt       0x15++#define AtomVariable    0x1a+#define AtomConstructor 0x1b+#define AtomAbstract    0x1c++#define ListCons        0x1d++#define eof		0x1f	/* Note: dummy eof value is lower5(-1) */++/* Handy definitions for Booleans */+typedef unsigned int Bool;+#ifndef False+#define False   0+#endif+#ifndef True+#define True    1+#endif++#endif
+ include/ntohl.h view
@@ -0,0 +1,13 @@++#if defined(WIN32)++/* Windows does not have ntohl, so define it here */+#define htonl(x) ntohl(x)+uint32_t ntohl(uint32_t x);++#else++/* Unix does, so just use it */+#include <netinet/in.h>		/* for ntohl() macro */++#endif /* WIN32 */
+ libhx/Array.hx view
@@ -0,0 +1,22 @@+module Array+(Var "!",Value {args = 1, fixity = L, priority = 9, letBound = True, traced = False})+(Var "//",Value {args = 2, fixity = L, priority = 9, letBound = True, traced = False})+(Var "accum",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "accumArray",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "array",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "assocs",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "bounds",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "elems",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "indices",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "ixmap",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "listArray",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Ix" "(7:8-7:9,Ix).inRange",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Ix" "(7:8-7:9,Ix).index",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Ix" "(7:8-7:9,Ix).range",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Ix" "(7:8-7:9,Ix).rangeSize",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Ix" "inRange",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Ix" "index",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Ix" "range",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Ix" "rangeSize",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(TypeClass "Array",TyCls (Ty [] []))+(TypeClass "Ix",TyCls (Cls ["range","index","inRange","rangeSize"]))
+ libhx/CPUTime.hx view
@@ -0,0 +1,3 @@+module CPUTime+(Var "cpuTimePrecision",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "getCPUTime",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})
+ libhx/Char.hx view
@@ -0,0 +1,24 @@+module Char+(Var "chr",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "digitToInt",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "intToDigit",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isAlpha",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isAlphaNum",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isAscii",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isControl",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isDigit",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isHexDigit",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isLatin1",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isLower",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isOctDigit",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isPrint",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isSpace",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isUpper",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "lexLitChar",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "ord",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readLitChar",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showLitChar",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "toLower",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "toUpper",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(TypeClass "Char",TyCls (Ty [] []))+(TypeClass "String",TyCls (Ty [] []))
+ libhx/Complex.hx view
@@ -0,0 +1,11 @@+module Complex+(Var "cis",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "conjugate",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "imagPart",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "magnitude",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "mkPolar",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "phase",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "polar",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "realPart",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Complex" ":+",Value {args = 2, fixity = None, priority = 6, letBound = True, traced = False})+(TypeClass "Complex",TyCls (Ty [":+"] []))
+ libhx/Directory.hx view
@@ -0,0 +1,20 @@+module Directory+(Var "createDirectory",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "doesDirectoryExist",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "doesFileExist",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "getCurrentDirectory",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "getDirectoryContents",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "getModificationTime",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "getPermissions",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "removeDirectory",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "removeFile",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "renameDirectory",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "renameFile",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "setCurrentDirectory",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "setPermissions",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Permissions" "Permissions",Value {args = 4, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "Permissions" "executable",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "Permissions" "readable",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "Permissions" "searchable",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "Permissions" "writable",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(TypeClass "Permissions",TyCls (Ty ["Permissions"] ["readable","writable","executable","searchable"]))
+ libhx/DirectoryBuiltin.hx view
@@ -0,0 +1,1 @@+module DirectoryBuiltin
+ libhx/DirectoryBuiltinTypes.hx view
@@ -0,0 +1,7 @@+module DirectoryBuiltinTypes+(Con Data "Permissions" "Permissions",Value {args = 4, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "Permissions" "executable",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "Permissions" "readable",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "Permissions" "searchable",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "Permissions" "writable",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(TypeClass "Permissions",TyCls (Ty ["Permissions"] ["readable","writable","executable","searchable"]))
+ libhx/IO.hx view
@@ -0,0 +1,78 @@+module IO+(Var "appendFile",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "bracket",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "bracket_",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "catch",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "getChar",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "getContents",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "getLine",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "hClose",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "hFileSize",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "hFlush",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "hGetBuffering",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "hGetChar",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "hGetContents",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "hGetLine",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "hGetPosn",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "hIsClosed",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "hIsEOF",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "hIsOpen",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "hIsReadable",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "hIsSeekable",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "hIsWritable",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "hLookAhead",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "hPrint",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "hPutChar",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "hPutStr",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "hPutStrLn",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "hReady",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "hSeek",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "hSetBuffering",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "hSetPosn",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "hWaitForInput",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "interact",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "ioError",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "ioeGetErrorString",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "ioeGetFileName",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "ioeGetHandle",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isAlreadyExistsError",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isAlreadyInUseError",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isDoesNotExistError",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isEOF",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isEOFError",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isFullError",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isIllegalOperation",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isPermissionError",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isUserError",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "openFile",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "print",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "putChar",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "putStr",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "putStrLn",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readFile",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readIO",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readLn",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "stderr",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "stdin",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "stdout",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "try",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "userError",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "writeFile",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "BufferMode" "BlockBuffering",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "BufferMode" "LineBuffering",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "BufferMode" "NoBuffering",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "IOMode" "AppendMode",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "IOMode" "ReadMode",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "IOMode" "ReadWriteMode",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "IOMode" "WriteMode",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "SeekMode" "AbsoluteSeek",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "SeekMode" "RelativeSeek",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "SeekMode" "SeekFromEnd",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(TypeClass "BufferMode",TyCls (Ty ["NoBuffering","LineBuffering","BlockBuffering"] []))+(TypeClass "FilePath",TyCls (Syn 0 THelper))+(TypeClass "Handle",TyCls (Ty [] []))+(TypeClass "HandlePosn",TyCls (Ty [] []))+(TypeClass "IO",TyCls (Ty [] []))+(TypeClass "IOError",TyCls (Ty [] []))+(TypeClass "IOMode",TyCls (Ty ["ReadMode","WriteMode","AppendMode","ReadWriteMode"] []))+(TypeClass "SeekMode",TyCls (Ty ["AbsoluteSeek","RelativeSeek","SeekFromEnd"] []))
+ libhx/IOBuiltin.hx view
@@ -0,0 +1,3 @@+module IOBuiltin+(TypeClass "Handle", TyCls (Ty [] []))+(TypeClass "HandlePosn", TyCls (Ty [] []))
+ libhx/IOBuiltinTypes.hx view
@@ -0,0 +1,14 @@+module IOBuiltinTypes+(Con Data "BufferMode" "BlockBuffering",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "BufferMode" "LineBuffering",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "BufferMode" "NoBuffering",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "IOMode" "AppendMode",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "IOMode" "ReadMode",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "IOMode" "ReadWriteMode",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "IOMode" "WriteMode",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "SeekMode" "AbsoluteSeek",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "SeekMode" "RelativeSeek",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "SeekMode" "SeekFromEnd",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(TypeClass "BufferMode",TyCls (Ty ["NoBuffering","LineBuffering","BlockBuffering"] []))+(TypeClass "IOMode",TyCls (Ty ["ReadMode","WriteMode","AppendMode","ReadWriteMode"] []))+(TypeClass "SeekMode",TyCls (Ty ["AbsoluteSeek","RelativeSeek","SeekFromEnd"] []))
+ libhx/Ix.hx view
@@ -0,0 +1,6 @@+module Ix+(Method "Ix" "inRange",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Ix" "index",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Ix" "range",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Ix" "rangeSize",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(TypeClass "Ix",TyCls (Cls ["range","index","inRange","rangeSize"]))
+ libhx/List.hx view
@@ -0,0 +1,105 @@+module List+(Var "!!",Value {args = 2, fixity = L, priority = 9, letBound = True, traced = False})+(Var "++",Value {args = 2, fixity = R, priority = 5, letBound = True, traced = False})+(Var "\\\\",Value {args = 0, fixity = None, priority = 5, letBound = True, traced = False})+(Var "all",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "and",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "any",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "break",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "concat",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "concatMap",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "cycle",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "delete",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "deleteBy",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "deleteFirstsBy",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "drop",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "dropWhile",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "elem",Value {args = 1, fixity = None, priority = 4, letBound = True, traced = False})+(Var "elemIndex",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "elemIndices",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "filter",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "find",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "findIndex",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "findIndices",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "foldl",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "foldl1",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "foldr",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "foldr1",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "genericDrop",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "genericIndex",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "genericLength",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "genericReplicate",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "genericSplitAt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "genericTake",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "group",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "groupBy",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "head",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "init",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "inits",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "insert",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "insertBy",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "intersect",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "intersectBy",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "intersperse",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isPrefixOf",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isSuffixOf",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "iterate",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "last",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "length",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "lines",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "lookup",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "map",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "mapAccumL",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "mapAccumR",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "maximum",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "maximumBy",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "minimum",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "minimumBy",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "notElem",Value {args = 1, fixity = None, priority = 4, letBound = True, traced = False})+(Var "nub",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "nubBy",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "null",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "or",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "partition",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "product",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "repeat",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "replicate",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "reverse",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "scanl",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "scanl1",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "scanr",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "scanr1",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "sort",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "sortBy",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "span",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "splitAt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "sum",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "tail",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "tails",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "take",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "takeWhile",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "transpose",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "unfoldr",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "union",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "unionBy",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "unlines",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "unwords",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "unzip",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "unzip3",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "unzip4",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "unzip5",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "unzip6",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "unzip7",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "words",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zip",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zip3",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zip4",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zip5",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zip6",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zip7",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zipWith",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zipWith3",Value {args = 4, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zipWith4",Value {args = 5, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zipWith5",Value {args = 6, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zipWith6",Value {args = 7, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zipWith7",Value {args = 8, fixity = Def, priority = 9, letBound = True, traced = False})
+ libhx/Locale.hx view
@@ -0,0 +1,11 @@+module Locale+(Var "defaultTimeLocale",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "TimeLocale" "TimeLocale",Value {args = 7, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "TimeLocale" "amPm",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "TimeLocale" "dateFmt",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "TimeLocale" "dateTimeFmt",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "TimeLocale" "months",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "TimeLocale" "time12Fmt",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "TimeLocale" "timeFmt",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "TimeLocale" "wDays",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(TypeClass "TimeLocale",TyCls (Ty ["TimeLocale"] ["wDays","months","amPm","dateTimeFmt","dateFmt","timeFmt","time12Fmt"]))
+ libhx/Maybe.hx view
@@ -0,0 +1,13 @@+module Maybe+(Var "catMaybes",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "fromJust",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "fromMaybe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isJust",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isNothing",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "listToMaybe",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "mapMaybe",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "maybe",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "maybeToList",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Maybe" "Just",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Maybe" "Nothing",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(TypeClass "Maybe",TyCls (Ty ["Nothing","Just"] []))
+ libhx/Monad.hx view
@@ -0,0 +1,32 @@+module Monad+(Var "=<<",Value {args = 2, fixity = R, priority = 1, letBound = True, traced = False})+(Var "ap",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "filterM",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "foldM",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "guard",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "join",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "liftM",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "liftM2",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "liftM3",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "liftM4",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "liftM5",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "mapAndUnzipM",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "mapM",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "mapM_",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "msum",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "sequence",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "sequence_",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "unless",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "when",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zipWithM",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zipWithM_",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Functor" "fmap",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Monad" ">>",Value {args = -1, fixity = L, priority = 1, letBound = True, traced = False})+(Method "Monad" ">>=",Value {args = -1, fixity = L, priority = 1, letBound = True, traced = False})+(Method "Monad" "fail",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Monad" "return",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "MonadPlus" "mplus",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "MonadPlus" "mzero",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(TypeClass "Functor",TyCls (Cls ["fmap"]))+(TypeClass "Monad",TyCls (Cls [">>=",">>","return","fail"]))+(TypeClass "MonadPlus",TyCls (Cls ["mzero","mplus"]))
+ libhx/Numeric.hx view
@@ -0,0 +1,19 @@+module Numeric+(Var "floatToDigits",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "fromRat",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "lexDigits",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readDec",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readFloat",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readHex",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readInt",Value {args = 4, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readOct",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readSigned",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showEFloat",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showFFloat",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showFloat",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showGFloat",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showHex",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showInt",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showIntAtBase",Value {args = 4, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showOct",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showSigned",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})
+ libhx/Prelude.hx view
@@ -0,0 +1,273 @@+module Prelude+(Var "!!",Value {args = 2, fixity = L, priority = 9, letBound = True, traced = False})+(Var "$",Value {args = 2, fixity = R, priority = 0, letBound = True, traced = False})+(Var "$!",Value {args = 2, fixity = R, priority = 0, letBound = True, traced = False})+(Var "&&",Value {args = 2, fixity = R, priority = 3, letBound = True, traced = False})+(Var "++",Value {args = 2, fixity = R, priority = 5, letBound = True, traced = False})+(Var ".",Value {args = 3, fixity = R, priority = 9, letBound = True, traced = False})+(Var "=<<",Value {args = 2, fixity = R, priority = 1, letBound = True, traced = False})+(Var "^",Value {args = 2, fixity = R, priority = 8, letBound = True, traced = False})+(Var "^^",Value {args = 2, fixity = R, priority = 8, letBound = True, traced = False})+(Var "_filter",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "_foldr",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "all",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "and",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "any",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "appendFile",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "asTypeOf",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "break",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "catch",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "concat",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "concatMap",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "const",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "curry",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "cycle",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "drop",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "dropWhile",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "either",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "elem",Value {args = 1, fixity = None, priority = 4, letBound = True, traced = False})+(Var "error",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "even",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "filter",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "flip",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "foldl",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "foldl1",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "foldr",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "foldr1",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "fromIntegral",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "fst",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "gcd",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "getChar",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "getContents",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "getLine",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "head",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "id",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "init",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "interact",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "ioError",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "iterate",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "last",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "lcm",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "length",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "lex",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "lines",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "lookup",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "map",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "mapM",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "mapM_",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "maximum",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "maybe",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "minimum",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "not",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "notElem",Value {args = 1, fixity = None, priority = 4, letBound = True, traced = False})+(Var "null",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "odd",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "or",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "otherwise",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "print",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "product",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "putChar",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "putStr",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "putStrLn",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "read",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readFile",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readIO",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readLn",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readParen",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "reads",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "realToFrac",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "repeat",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "replicate",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "reverse",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "scanl",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "scanl1",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "scanr",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "scanr1",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "seq",Value {args = 2, fixity = R, priority = 0, letBound = True, traced = False})+(Var "sequence",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "sequence_",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showChar",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showParen",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showString",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "shows",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "snd",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "span",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "splitAt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "subtract",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "sum",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "tail",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "take",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "takeWhile",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "uncurry",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "undefined",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "unlines",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "until",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "unwords",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "unzip",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "unzip3",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "userError",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "words",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "writeFile",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zip",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zip3",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zipWith",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zipWith3",Value {args = 4, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "||",Value {args = 2, fixity = R, priority = 2, letBound = True, traced = False})+(Con Data "()" "()",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Bool" "False",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Bool" "True",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Either" "Left",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Either" "Right",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Maybe" "Just",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Maybe" "Nothing",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Ordering" "EQ",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Ordering" "GT",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Ordering" "LT",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.10" "Prelude.10",Value {args = 10, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.11" "Prelude.11",Value {args = 11, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.12" "Prelude.12",Value {args = 12, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.13" "Prelude.13",Value {args = 13, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.14" "Prelude.14",Value {args = 14, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.15" "Prelude.15",Value {args = 15, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.2" "Prelude.2",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.3" "Prelude.3",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.4" "Prelude.4",Value {args = 4, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.5" "Prelude.5",Value {args = 5, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.6" "Prelude.6",Value {args = 6, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.7" "Prelude.7",Value {args = 7, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.8" "Prelude.8",Value {args = 8, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.9" "Prelude.9",Value {args = 9, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "[]" ":",Value {args = 2, fixity = R, priority = 5, letBound = True, traced = False})+(Con Data "[]" "[]",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Bounded" "maxBound",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Bounded" "minBound",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Enum" "enumFrom",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Enum" "enumFromThen",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Enum" "enumFromThenTo",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Enum" "enumFromTo",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Enum" "fromEnum",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Enum" "pred",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Enum" "succ",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Enum" "toEnum",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Eq" "/=",Value {args = -1, fixity = None, priority = 4, letBound = True, traced = False})+(Method "Eq" "==",Value {args = -1, fixity = None, priority = 4, letBound = True, traced = False})+(Method "Floating" "**",Value {args = -1, fixity = R, priority = 8, letBound = True, traced = False})+(Method "Floating" "acos",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "acosh",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "asin",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "asinh",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "atan",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "atanh",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "cos",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "cosh",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "exp",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "log",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "logBase",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "pi",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "sin",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "sinh",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "sqrt",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "tan",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "tanh",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Fractional" "/",Value {args = -1, fixity = L, priority = 7, letBound = True, traced = False})+(Method "Fractional" "fromRational",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Fractional" "recip",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Functor" "fmap",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Integral" "div",Value {args = -1, fixity = L, priority = 7, letBound = True, traced = False})+(Method "Integral" "divMod",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Integral" "mod",Value {args = -1, fixity = L, priority = 7, letBound = True, traced = False})+(Method "Integral" "quot",Value {args = -1, fixity = L, priority = 7, letBound = True, traced = False})+(Method "Integral" "quotRem",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Integral" "rem",Value {args = -1, fixity = L, priority = 7, letBound = True, traced = False})+(Method "Integral" "toInteger",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Monad" ">>",Value {args = -1, fixity = L, priority = 1, letBound = True, traced = False})+(Method "Monad" ">>=",Value {args = -1, fixity = L, priority = 1, letBound = True, traced = False})+(Method "Monad" "fail",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Monad" "return",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Num" "*",Value {args = -1, fixity = L, priority = 7, letBound = True, traced = False})+(Method "Num" "+",Value {args = -1, fixity = L, priority = 6, letBound = True, traced = False})+(Method "Num" "-",Value {args = -1, fixity = L, priority = 6, letBound = True, traced = False})+(Method "Num" "abs",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Num" "fromInteger",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Num" "negate",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Num" "signum",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Ord" "<",Value {args = -1, fixity = None, priority = 4, letBound = True, traced = False})+(Method "Ord" "<=",Value {args = -1, fixity = None, priority = 4, letBound = True, traced = False})+(Method "Ord" ">",Value {args = -1, fixity = None, priority = 4, letBound = True, traced = False})+(Method "Ord" ">=",Value {args = -1, fixity = None, priority = 4, letBound = True, traced = False})+(Method "Ord" "compare",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Ord" "max",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Ord" "min",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Read" "readList",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Read" "readsPrec",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Real" "toRational",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "atan2",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "decodeFloat",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "encodeFloat",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "exponent",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "floatDigits",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "floatRadix",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "floatRange",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "isDenormalized",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "isIEEE",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "isInfinite",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "isNaN",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "isNegativeZero",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "scaleFloat",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "significand",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFrac" "ceiling",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFrac" "floor",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFrac" "properFraction",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFrac" "round",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFrac" "truncate",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Show" "show",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Show" "showList",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Show" "showsPrec",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(TypeClass "()",TyCls (Ty ["()"] []))+(TypeClass "->",TyCls (Ty [] []))+(TypeClass "Bool",TyCls (Ty ["False","True"] []))+(TypeClass "Bounded",TyCls (Cls ["minBound","maxBound"]))+(TypeClass "Char",TyCls (Ty [] []))+(TypeClass "Double",TyCls (Ty [] []))+(TypeClass "Either",TyCls (Ty ["Left","Right"] []))+(TypeClass "Enum",TyCls (Cls ["succ","pred","toEnum","fromEnum","enumFrom","enumFromThen","enumFromTo","enumFromThenTo"]))+(TypeClass "Eq",TyCls (Cls ["==","/="]))+(TypeClass "FilePath",TyCls (Syn 0 THelper))+(TypeClass "Float",TyCls (Ty [] []))+(TypeClass "Floating",TyCls (Cls ["pi","exp","log","sqrt","**","logBase","sin","cos","tan","asin","acos","atan","sinh","cosh","tanh","asinh","acosh","atanh"]))+(TypeClass "Fractional",TyCls (Cls ["/","recip","fromRational"]))+(TypeClass "Functor",TyCls (Cls ["fmap"]))+(TypeClass "IO",TyCls (Ty [] []))+(TypeClass "IOError",TyCls (Ty [] []))+(TypeClass "Int",TyCls (Ty [] []))+(TypeClass "Integer",TyCls (Ty [] []))+(TypeClass "Integral",TyCls (Cls ["quot","rem","div","mod","quotRem","divMod","toInteger"]))+(TypeClass "Maybe",TyCls (Ty ["Nothing","Just"] []))+(TypeClass "Monad",TyCls (Cls [">>=",">>","return","fail"]))+(TypeClass "Num",TyCls (Cls ["+","-","*","negate","abs","signum","fromInteger"]))+(TypeClass "Ord",TyCls (Cls ["compare","<","<=",">=",">","max","min"]))+(TypeClass "Ordering",TyCls (Ty ["LT","EQ","GT"] []))+(TypeClass "Prelude.10",TyCls (Ty ["Prelude.10"] []))+(TypeClass "Prelude.11",TyCls (Ty ["Prelude.11"] []))+(TypeClass "Prelude.12",TyCls (Ty ["Prelude.12"] []))+(TypeClass "Prelude.13",TyCls (Ty ["Prelude.13"] []))+(TypeClass "Prelude.14",TyCls (Ty ["Prelude.14"] []))+(TypeClass "Prelude.15",TyCls (Ty ["Prelude.15"] []))+(TypeClass "Prelude.2",TyCls (Ty ["Prelude.2"] []))+(TypeClass "Prelude.3",TyCls (Ty ["Prelude.3"] []))+(TypeClass "Prelude.4",TyCls (Ty ["Prelude.4"] []))+(TypeClass "Prelude.5",TyCls (Ty ["Prelude.5"] []))+(TypeClass "Prelude.6",TyCls (Ty ["Prelude.6"] []))+(TypeClass "Prelude.7",TyCls (Ty ["Prelude.7"] []))+(TypeClass "Prelude.8",TyCls (Ty ["Prelude.8"] []))+(TypeClass "Prelude.9",TyCls (Ty ["Prelude.9"] []))+(TypeClass "Rational",TyCls (Syn 0 THelper))+(TypeClass "Read",TyCls (Cls ["readsPrec","readList"]))+(TypeClass "ReadS",TyCls (Syn 2 (TApp (TApp TFun THelper) THelper)))+(TypeClass "Real",TyCls (Cls ["toRational"]))+(TypeClass "RealFloat",TyCls (Cls ["floatRadix","floatDigits","floatRange","decodeFloat","encodeFloat","exponent","significand","scaleFloat","isNaN","isInfinite","isDenormalized","isNegativeZero","isIEEE","atan2"]))+(TypeClass "RealFrac",TyCls (Cls ["properFraction","truncate","round","ceiling","floor"]))+(TypeClass "Show",TyCls (Cls ["showsPrec","show","showList"]))+(TypeClass "ShowS",TyCls (Syn 2 (TApp (TApp TFun THelper) THelper)))+(TypeClass "String",TyCls (Ty [] []))+(TypeClass "[]",TyCls (Ty ["[]",":"] []))
+ libhx/PreludeBasic.hx view
@@ -0,0 +1,597 @@+module PreludeBasic+(Var "!!",Value {args = 2, fixity = L, priority = 9, letBound = True, traced = False})+(Var "$",Value {args = 2, fixity = R, priority = 0, letBound = True, traced = False})+(Var "$!",Value {args = 2, fixity = R, priority = 0, letBound = True, traced = False})+(Var "%",Value {args = 2, fixity = L, priority = 7, letBound = True, traced = False})+(Var "&&",Value {args = 2, fixity = R, priority = 3, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).appendFile",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).catch",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).error",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).getChar",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).getContents",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).ioError",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).isAlpha",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).isAlphaNum",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).isAscii",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).isControl",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).isDigit",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).isHexDigit",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).isLatin1",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).isLower",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).isOctDigit",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).isPrint",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).isSpace",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).isUpper",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primCharToInt",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDecodeDouble",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDecodeFloat",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleAbs",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleAcos",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleAdd",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleAsin",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleAtan",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleCos",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleDigits",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleDiv",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleEq",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleExp",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleFromInteger",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleGe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleGt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleIsDenormalized",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleIsIEEE",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleIsInfinite",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleIsNaN",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleIsNegativeZero",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleLe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleLog",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleLt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleMul",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleNe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoublePi",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleRadix",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleRange",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleSignum",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleSin",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleSqrt",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleSub",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primDoubleTan",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primEncodeDouble",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primEncodeFloat",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatAbs",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatAcos",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatAdd",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatAsin",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatAtan",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatCos",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatDigits",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatDiv",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatEq",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatExp",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatFromInteger",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatGe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatGt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatIsDenormalized",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatIsIEEE",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatIsInfinite",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatIsNaN",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatIsNegativeZero",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatLe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatLog",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatLt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatMul",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatNe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatPi",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatRadix",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatRange",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatSignum",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatSin",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatSqrt",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatSub",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primFloatTan",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIOBind",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIOErrorShow",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIOReturn",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntAbs",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntEq",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntFromInteger",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntGe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntGt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntLe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntLt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntMaxBound",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntMinBound",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntMinus",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntNe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntNegate",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntPlus",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntQuot",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntRem",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntSignum",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntTimes",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntToChar",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntegerAdd",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntegerEq",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntegerFromInt",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntegerGe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntegerGt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntegerLe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntegerLt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntegerMul",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntegerNe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntegerNeg",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntegerQuot",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntegerQuotRem",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntegerRem",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primIntegerSub",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).primUnicodeMaxBound",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).putChar",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).readFile",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).seq",Value {args = 2, fixity = R, priority = 0, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).toLower",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).toUpper",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).undefined",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).userError",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "(19:8-19:21,PreludeBuiltin).writeFile",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "++",Value {args = 2, fixity = R, priority = 5, letBound = True, traced = False})+(Var ".",Value {args = 3, fixity = R, priority = 9, letBound = True, traced = False})+(Var "=<<",Value {args = 2, fixity = R, priority = 1, letBound = True, traced = False})+(Var "^",Value {args = 2, fixity = R, priority = 8, letBound = True, traced = False})+(Var "^^",Value {args = 2, fixity = R, priority = 8, letBound = True, traced = False})+(Var "_filter",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "_foldr",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "all",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "alt",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "and",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "any",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "appendFile",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "approxRational",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "asTypeOf",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "asciiTab",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "break",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "catch",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "chr",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "concat",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "concatMap",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "const",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "curry",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "cycle",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "denominator",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "digitToInt",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "drop",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "dropWhile",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "either",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "elem",Value {args = 1, fixity = None, priority = 4, letBound = True, traced = False})+(Var "error",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "even",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "expt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "expts",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "filter",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "flip",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "floatToDigits",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "foldl",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "foldl1",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "foldr",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "foldr1",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "formatRealFloat",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "fromIntegral",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "fromRat",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "fromRat'",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "fst",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "gcd",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "getChar",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "getContents",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "getLine",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "head",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "id",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "init",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "intEnumFromByTo",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "intToDigit",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "integerLogBase",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "interact",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "ioError",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isAlpha",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isAlphaNum",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isAscii",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isControl",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isDigit",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isHexDigit",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isLatin1",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isLower",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isOctDigit",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isPrint",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isSpace",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isUpper",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "iterate",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "last",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "lcm",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "length",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "lex",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "lexDigits",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "lexLitChar",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "lift",Value {args = 4, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "lines",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "lookup",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "map",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "mapM",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "mapM_",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "maxExpt",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "maximum",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "maybe",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "minExpt",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "minimum",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "nonnull",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "not",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "notElem",Value {args = 1, fixity = None, priority = 4, letBound = True, traced = False})+(Var "null",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "numerator",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "numericEnumFrom",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "numericEnumFromThen",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "numericEnumFromThenTo",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "numericEnumFromTo",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "odd",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "or",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "ord",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "otherwise",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "prec",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primCharToInt",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDecodeDouble",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDecodeFloat",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleAbs",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleAcos",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleAdd",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleAsin",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleAtan",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleCos",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleDigits",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleDiv",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleEq",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleExp",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleFromInteger",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleGe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleGt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleIsDenormalized",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleIsIEEE",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleIsInfinite",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleIsNaN",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleIsNegativeZero",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleLe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleLog",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleLt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleMul",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleNe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoublePi",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleRadix",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleRange",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleSignum",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleSin",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleSqrt",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleSub",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleTan",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primEncodeDouble",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primEncodeFloat",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatAbs",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatAcos",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatAdd",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatAsin",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatAtan",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatCos",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatDigits",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatDiv",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatEq",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatExp",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatFromInteger",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatGe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatGt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatIsDenormalized",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatIsIEEE",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatIsInfinite",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatIsNaN",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatIsNegativeZero",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatLe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatLog",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatLt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatMul",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatNe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatPi",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatRadix",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatRange",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatSignum",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatSin",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatSqrt",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatSub",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatTan",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIOBind",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIOErrorShow",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIOReturn",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntAbs",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntEq",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntFromInteger",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntGe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntGt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntLe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntLt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntMaxBound",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntMinBound",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntMinus",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntNe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntNegate",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntPlus",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntQuot",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntRem",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntSignum",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntTimes",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntToChar",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerAdd",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerEq",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerFromInt",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerGe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerGt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerLe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerLt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerMul",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerNe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerNeg",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerQuot",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerQuotRem",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerRem",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerSub",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primUnicodeMaxBound",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "print",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "product",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "protectEsc",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "putChar",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "putStr",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "putStrLn",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "read",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readDec",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readFile",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readFloat",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readHex",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readIO",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readInt",Value {args = 4, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readLitChar",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readLn",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readOct",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readParen",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readSigned",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "reads",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "realToFrac",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "reduce",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "repeat",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "replicate",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "reverse",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "roundTo",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "scaleRat",Value {args = 6, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "scanl",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "scanl1",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "scanr",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "scanr1",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "seq",Value {args = 2, fixity = R, priority = 0, letBound = True, traced = False})+(Var "sequence",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "sequence_",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showChar",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showEFloat",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showFFloat",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showFloat",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showGFloat",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showHex",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showInt",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showIntAtBase",Value {args = 4, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showLitChar",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showOct",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showParen",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showSigned",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showString",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "shows",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "snd",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "span",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "splitAt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "subtract",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "sum",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "tail",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "take",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "takeWhile",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "thenAp",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "thenLex",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "toLower",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "toUpper",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "uncurry",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "undefined",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "unlines",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "until",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "unwords",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "unzip",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "unzip3",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "userError",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "words",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "writeFile",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "yield",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zip",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zip3",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zipWith",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zipWith3",Value {args = 4, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "||",Value {args = 2, fixity = R, priority = 2, letBound = True, traced = False})+(Con Data "()" "()",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "()" "(19:8-19:21,PreludeBuiltin).()",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Bool" "(19:8-19:21,PreludeBuiltin).False",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Bool" "(19:8-19:21,PreludeBuiltin).True",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Bool" "False",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Bool" "True",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Either" "Left",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Either" "Right",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "FFFormat" "FFExponent",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "FFFormat" "FFFixed",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "FFFormat" "FFGeneric",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Maybe" "Just",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Maybe" "Nothing",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Ordering" "EQ",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Ordering" "GT",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Ordering" "LT",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.10" "(19:8-19:21,PreludeBuiltin).Prelude.10",Value {args = 10, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.10" "Prelude.10",Value {args = 10, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.11" "(19:8-19:21,PreludeBuiltin).Prelude.11",Value {args = 11, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.11" "Prelude.11",Value {args = 11, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.12" "(19:8-19:21,PreludeBuiltin).Prelude.12",Value {args = 12, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.12" "Prelude.12",Value {args = 12, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.13" "(19:8-19:21,PreludeBuiltin).Prelude.13",Value {args = 13, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.13" "Prelude.13",Value {args = 13, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.14" "(19:8-19:21,PreludeBuiltin).Prelude.14",Value {args = 14, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.14" "Prelude.14",Value {args = 14, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.15" "(19:8-19:21,PreludeBuiltin).Prelude.15",Value {args = 15, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.15" "Prelude.15",Value {args = 15, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.2" "(19:8-19:21,PreludeBuiltin).Prelude.2",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.2" "Prelude.2",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.3" "(19:8-19:21,PreludeBuiltin).Prelude.3",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.3" "Prelude.3",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.4" "(19:8-19:21,PreludeBuiltin).Prelude.4",Value {args = 4, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.4" "Prelude.4",Value {args = 4, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.5" "(19:8-19:21,PreludeBuiltin).Prelude.5",Value {args = 5, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.5" "Prelude.5",Value {args = 5, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.6" "(19:8-19:21,PreludeBuiltin).Prelude.6",Value {args = 6, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.6" "Prelude.6",Value {args = 6, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.7" "(19:8-19:21,PreludeBuiltin).Prelude.7",Value {args = 7, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.7" "Prelude.7",Value {args = 7, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.8" "(19:8-19:21,PreludeBuiltin).Prelude.8",Value {args = 8, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.8" "Prelude.8",Value {args = 8, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.9" "(19:8-19:21,PreludeBuiltin).Prelude.9",Value {args = 9, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.9" "Prelude.9",Value {args = 9, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Ratio" ":%",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "[]" "(19:8-19:21,PreludeBuiltin).:",Value {args = 2, fixity = R, priority = 5, letBound = True, traced = False})+(Con Data "[]" "(19:8-19:21,PreludeBuiltin).[]",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "[]" ":",Value {args = 2, fixity = R, priority = 5, letBound = True, traced = False})+(Con Data "[]" "[]",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Bounded" "maxBound",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Bounded" "minBound",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Enum" "enumFrom",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Enum" "enumFromThen",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Enum" "enumFromThenTo",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Enum" "enumFromTo",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Enum" "fromEnum",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Enum" "pred",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Enum" "succ",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Enum" "toEnum",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Eq" "/=",Value {args = -1, fixity = None, priority = 4, letBound = True, traced = False})+(Method "Eq" "==",Value {args = -1, fixity = None, priority = 4, letBound = True, traced = False})+(Method "Floating" "**",Value {args = -1, fixity = R, priority = 8, letBound = True, traced = False})+(Method "Floating" "acos",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "acosh",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "asin",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "asinh",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "atan",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "atanh",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "cos",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "cosh",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "exp",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "log",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "logBase",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "pi",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "sin",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "sinh",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "sqrt",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "tan",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "tanh",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Fractional" "/",Value {args = -1, fixity = L, priority = 7, letBound = True, traced = False})+(Method "Fractional" "fromRational",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Fractional" "recip",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Functor" "fmap",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Integral" "div",Value {args = -1, fixity = L, priority = 7, letBound = True, traced = False})+(Method "Integral" "divMod",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Integral" "mod",Value {args = -1, fixity = L, priority = 7, letBound = True, traced = False})+(Method "Integral" "quot",Value {args = -1, fixity = L, priority = 7, letBound = True, traced = False})+(Method "Integral" "quotRem",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Integral" "rem",Value {args = -1, fixity = L, priority = 7, letBound = True, traced = False})+(Method "Integral" "toInteger",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Monad" ">>",Value {args = -1, fixity = L, priority = 1, letBound = True, traced = False})+(Method "Monad" ">>=",Value {args = -1, fixity = L, priority = 1, letBound = True, traced = False})+(Method "Monad" "fail",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Monad" "return",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Num" "*",Value {args = -1, fixity = L, priority = 7, letBound = True, traced = False})+(Method "Num" "+",Value {args = -1, fixity = L, priority = 6, letBound = True, traced = False})+(Method "Num" "-",Value {args = -1, fixity = L, priority = 6, letBound = True, traced = False})+(Method "Num" "abs",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Num" "fromInteger",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Num" "negate",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Num" "signum",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Ord" "<",Value {args = -1, fixity = None, priority = 4, letBound = True, traced = False})+(Method "Ord" "<=",Value {args = -1, fixity = None, priority = 4, letBound = True, traced = False})+(Method "Ord" ">",Value {args = -1, fixity = None, priority = 4, letBound = True, traced = False})+(Method "Ord" ">=",Value {args = -1, fixity = None, priority = 4, letBound = True, traced = False})+(Method "Ord" "compare",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Ord" "max",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Ord" "min",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Read" "readList",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Read" "readsPrec",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Real" "toRational",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "atan2",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "decodeFloat",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "encodeFloat",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "exponent",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "floatDigits",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "floatRadix",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "floatRange",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "isDenormalized",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "isIEEE",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "isInfinite",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "isNaN",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "isNegativeZero",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "scaleFloat",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "significand",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFrac" "ceiling",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFrac" "floor",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFrac" "properFraction",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFrac" "round",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFrac" "truncate",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Show" "show",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Show" "showList",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Show" "showsPrec",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(TypeClass "()",TyCls (Ty ["()"] []))+(TypeClass "->",TyCls (Ty [] []))+(TypeClass "Bool",TyCls (Ty ["False","True"] []))+(TypeClass "Bounded",TyCls (Cls ["minBound","maxBound"]))+(TypeClass "Char",TyCls (Ty [] []))+(TypeClass "Double",TyCls (Ty [] []))+(TypeClass "Either",TyCls (Ty ["Left","Right"] []))+(TypeClass "Enum",TyCls (Cls ["succ","pred","toEnum","fromEnum","enumFrom","enumFromThen","enumFromTo","enumFromThenTo"]))+(TypeClass "Eq",TyCls (Cls ["==","/="]))+(TypeClass "FFFormat",TyCls (Ty ["FFExponent","FFFixed","FFGeneric"] []))+(TypeClass "FilePath",TyCls (Syn 0 THelper))+(TypeClass "Float",TyCls (Ty [] []))+(TypeClass "Floating",TyCls (Cls ["pi","exp","log","sqrt","**","logBase","sin","cos","tan","asin","acos","atan","sinh","cosh","tanh","asinh","acosh","atanh"]))+(TypeClass "Fractional",TyCls (Cls ["/","recip","fromRational"]))+(TypeClass "Functor",TyCls (Cls ["fmap"]))+(TypeClass "IO",TyCls (Ty [] []))+(TypeClass "IOError",TyCls (Ty [] []))+(TypeClass "Int",TyCls (Ty [] []))+(TypeClass "Integer",TyCls (Ty [] []))+(TypeClass "Integral",TyCls (Cls ["quot","rem","div","mod","quotRem","divMod","toInteger"]))+(TypeClass "Maybe",TyCls (Ty ["Nothing","Just"] []))+(TypeClass "Monad",TyCls (Cls [">>=",">>","return","fail"]))+(TypeClass "Num",TyCls (Cls ["+","-","*","negate","abs","signum","fromInteger"]))+(TypeClass "Ord",TyCls (Cls ["compare","<","<=",">=",">","max","min"]))+(TypeClass "Ordering",TyCls (Ty ["LT","EQ","GT"] []))+(TypeClass "Prelude.10",TyCls (Ty ["Prelude.10"] []))+(TypeClass "Prelude.11",TyCls (Ty ["Prelude.11"] []))+(TypeClass "Prelude.12",TyCls (Ty ["Prelude.12"] []))+(TypeClass "Prelude.13",TyCls (Ty ["Prelude.13"] []))+(TypeClass "Prelude.14",TyCls (Ty ["Prelude.14"] []))+(TypeClass "Prelude.15",TyCls (Ty ["Prelude.15"] []))+(TypeClass "Prelude.2",TyCls (Ty ["Prelude.2"] []))+(TypeClass "Prelude.3",TyCls (Ty ["Prelude.3"] []))+(TypeClass "Prelude.4",TyCls (Ty ["Prelude.4"] []))+(TypeClass "Prelude.5",TyCls (Ty ["Prelude.5"] []))+(TypeClass "Prelude.6",TyCls (Ty ["Prelude.6"] []))+(TypeClass "Prelude.7",TyCls (Ty ["Prelude.7"] []))+(TypeClass "Prelude.8",TyCls (Ty ["Prelude.8"] []))+(TypeClass "Prelude.9",TyCls (Ty ["Prelude.9"] []))+(TypeClass "Ratio",TyCls (Ty [":%"] []))+(TypeClass "Rational",TyCls (Syn 0 THelper))+(TypeClass "Read",TyCls (Cls ["readsPrec","readList"]))+(TypeClass "ReadS",TyCls (Syn 2 (TApp (TApp TFun THelper) THelper)))+(TypeClass "Real",TyCls (Cls ["toRational"]))+(TypeClass "RealFloat",TyCls (Cls ["floatRadix","floatDigits","floatRange","decodeFloat","encodeFloat","exponent","significand","scaleFloat","isNaN","isInfinite","isDenormalized","isNegativeZero","isIEEE","atan2"]))+(TypeClass "RealFrac",TyCls (Cls ["properFraction","truncate","round","ceiling","floor"]))+(TypeClass "Show",TyCls (Cls ["showsPrec","show","showList"]))+(TypeClass "ShowS",TyCls (Syn 2 (TApp (TApp TFun THelper) THelper)))+(TypeClass "String",TyCls (Ty [] []))+(TypeClass "[]",TyCls (Ty ["[]",":"] []))
+ libhx/PreludeBuiltin.hx view
@@ -0,0 +1,175 @@+module PreludeBuiltin+(Var "appendFile",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "catch",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "error",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "getChar",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "getContents",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "ioError",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isAlpha",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isAlphaNum",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isAscii",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isControl",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isDigit",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isHexDigit",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isLatin1",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isLower",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isOctDigit",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isPrint",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isSpace",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "isUpper",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primCharToInt",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDecodeDouble",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDecodeFloat",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleAbs",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleAcos",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleAdd",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleAsin",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleAtan",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleCos",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleDigits",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleDiv",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleEq",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleExp",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleFromInteger",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleGe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleGt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleIsDenormalized",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleIsIEEE",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleIsInfinite",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleIsNaN",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleIsNegativeZero",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleLe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleLog",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleLt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleMul",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleNe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoublePi",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleRadix",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleRange",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleSignum",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleSin",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleSqrt",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleSub",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primDoubleTan",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primEncodeDouble",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primEncodeFloat",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatAbs",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatAcos",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatAdd",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatAsin",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatAtan",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatCos",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatDigits",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatDiv",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatEq",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatExp",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatFromInteger",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatGe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatGt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatIsDenormalized",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatIsIEEE",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatIsInfinite",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatIsNaN",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatIsNegativeZero",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatLe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatLog",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatLt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatMul",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatNe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatPi",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatRadix",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatRange",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatSignum",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatSin",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatSqrt",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatSub",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primFloatTan",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIOBind",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIOErrorShow",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIOReturn",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntAbs",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntEq",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntFromInteger",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntGe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntGt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntLe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntLt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntMaxBound",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntMinBound",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntMinus",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntNe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntNegate",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntPlus",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntQuot",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntRem",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntSignum",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntTimes",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntToChar",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerAdd",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerEq",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerFromInt",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerGe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerGt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerLe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerLt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerMul",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerNe",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerNeg",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerQuot",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerQuotRem",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerRem",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primIntegerSub",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "primUnicodeMaxBound",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "putChar",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readFile",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "seq",Value {args = 2, fixity = R, priority = 0, letBound = True, traced = False})+(Var "toLower",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "toUpper",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "undefined",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "userError",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "writeFile",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "()" "()",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Bool" "False",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Bool" "True",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.10" "Prelude.10",Value {args = 10, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.11" "Prelude.11",Value {args = 11, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.12" "Prelude.12",Value {args = 12, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.13" "Prelude.13",Value {args = 13, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.14" "Prelude.14",Value {args = 14, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.15" "Prelude.15",Value {args = 15, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.2" "Prelude.2",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.3" "Prelude.3",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.4" "Prelude.4",Value {args = 4, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.5" "Prelude.5",Value {args = 5, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.6" "Prelude.6",Value {args = 6, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.7" "Prelude.7",Value {args = 7, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.8" "Prelude.8",Value {args = 8, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Prelude.9" "Prelude.9",Value {args = 9, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "[]" ":",Value {args = 2, fixity = R, priority = 5, letBound = True, traced = False})+(Con Data "[]" "[]",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(TypeClass "()",TyCls (Ty ["()"] []))+(TypeClass "->",TyCls (Ty [] []))+(TypeClass "Bool",TyCls (Ty ["False","True"] []))+(TypeClass "Char",TyCls (Ty [] []))+(TypeClass "Double",TyCls (Ty [] []))+(TypeClass "Float",TyCls (Ty [] []))+(TypeClass "IO",TyCls (Ty [] []))+(TypeClass "IOError",TyCls (Ty [] []))+(TypeClass "Int",TyCls (Ty [] []))+(TypeClass "Integer",TyCls (Ty [] []))+(TypeClass "Prelude.10",TyCls (Ty ["Prelude.10"] []))+(TypeClass "Prelude.11",TyCls (Ty ["Prelude.11"] []))+(TypeClass "Prelude.12",TyCls (Ty ["Prelude.12"] []))+(TypeClass "Prelude.13",TyCls (Ty ["Prelude.13"] []))+(TypeClass "Prelude.14",TyCls (Ty ["Prelude.14"] []))+(TypeClass "Prelude.15",TyCls (Ty ["Prelude.15"] []))+(TypeClass "Prelude.2",TyCls (Ty ["Prelude.2"] []))+(TypeClass "Prelude.3",TyCls (Ty ["Prelude.3"] []))+(TypeClass "Prelude.4",TyCls (Ty ["Prelude.4"] []))+(TypeClass "Prelude.5",TyCls (Ty ["Prelude.5"] []))+(TypeClass "Prelude.6",TyCls (Ty ["Prelude.6"] []))+(TypeClass "Prelude.7",TyCls (Ty ["Prelude.7"] []))+(TypeClass "Prelude.8",TyCls (Ty ["Prelude.8"] []))+(TypeClass "Prelude.9",TyCls (Ty ["Prelude.9"] []))+(TypeClass "String",TyCls (Ty [] []))+(TypeClass "[]",TyCls (Ty ["[]",":"] []))
+ libhx/PreludeBuiltinTypes.hx view
@@ -0,0 +1,48 @@+module TPreludeBuiltinTypes+(TypeClass "IO", TyCls (Ty [] []))+(TypeClass "IOError", TyCls (Ty [] []))+(TypeClass "Double", TyCls (Ty [] []))+(TypeClass "Float", TyCls (Ty [] []))+(TypeClass "Integer", TyCls (Ty [] []))+(TypeClass "Int", TyCls (Ty [] []))+(TypeClass "Char", TyCls (Ty [] []))+(TypeClass "->", TyCls (Ty [] []))+(TypeClass "String", TyCls (Ty [] []))+(TypeClass "[]", TyCls (Ty ["[]",":"] []))+(TypeClass "Bool", TyCls (Ty ["False","True"] []))+(TypeClass "()", TyCls (Ty ["()"] []))+(TypeClass "Prelude.2", TyCls (Ty ["Prelude.2"] []))+(TypeClass "Prelude.3", TyCls (Ty ["Prelude.3"] []))+(TypeClass "Prelude.4", TyCls (Ty ["Prelude.4"] []))+(TypeClass "Prelude.5", TyCls (Ty ["Prelude.5"] []))+(TypeClass "Prelude.6", TyCls (Ty ["Prelude.6"] []))+(TypeClass "Prelude.7", TyCls (Ty ["Prelude.7"] []))+(TypeClass "Prelude.8", TyCls (Ty ["Prelude.8"] []))+(TypeClass "Prelude.9", TyCls (Ty ["Prelude.9"] []))+(TypeClass "Prelude.10", TyCls (Ty ["Prelude.10"] []))+(TypeClass "Prelude.11", TyCls (Ty ["Prelude.11"] []))+(TypeClass "Prelude.12", TyCls (Ty ["Prelude.12"] []))+(TypeClass "Prelude.13", TyCls (Ty ["Prelude.13"] []))+(TypeClass "Prelude.14", TyCls (Ty ["Prelude.14"] []))+(TypeClass "Prelude.15", TyCls (Ty ["Prelude.15"] []))+(Con Data "[]" ":",Value{args=2,fixity=R,priority=5,letBound=True,traced=False})+(Con Data "[]" "[]",Value{args=0,fixity=Def,priority=9,letBound=True,traced=False})+(Con Data "Bool" "False",Value{args=0,fixity=Def,priority=9,letBound=True,traced=False})+(Con Data "Bool" "True",Value{args=0,fixity=Def,priority=9,letBound=True,traced=False})+(Con Data "()" "()",Value{args=0,fixity=Def,priority=9,letBound=True,traced=False})+(Con Data "Prelude.2" "Prelude.2",Value{args=2,fixity=Def,priority=9,letBound=True,traced=False})+(Con Data "Prelude.3" "Prelude.3",Value{args=3,fixity=Def,priority=9,letBound=True,traced=False})+(Con Data "Prelude.4" "Prelude.4",Value{args=4,fixity=Def,priority=9,letBound=True,traced=False})+(Con Data "Prelude.5" "Prelude.5",Value{args=5,fixity=Def,priority=9,letBound=True,traced=False})+(Con Data "Prelude.6" "Prelude.6",Value{args=6,fixity=Def,priority=9,letBound=True,traced=False})+(Con Data "Prelude.7" "Prelude.7",Value{args=7,fixity=Def,priority=9,letBound=True,traced=False})+(Con Data "Prelude.8" "Prelude.8",Value{args=8,fixity=Def,priority=9,letBound=True,traced=False})+(Con Data "Prelude.9" "Prelude.9",Value{args=9,fixity=Def,priority=9,letBound=True,traced=False})+(Con Data "Prelude.10" "Prelude.10",Value{args=10,fixity=Def,priority=9,letBound=True,traced=False})+(Con Data "Prelude.11" "Prelude.11",Value{args=11,fixity=Def,priority=9,letBound=True,traced=False})+(Con Data "Prelude.12" "Prelude.12",Value{args=12,fixity=Def,priority=9,letBound=True,traced=False})+(Con Data "Prelude.13" "Prelude.13",Value{args=13,fixity=Def,priority=9,letBound=True,traced=False})+(Con Data "Prelude.14" "Prelude.14",Value{args=14,fixity=Def,priority=9,letBound=True,traced=False})+(Con Data "Prelude.15" "Prelude.15",Value{args=15,fixity=Def,priority=9,letBound=True,traced=False})+(Var "error",Value{args=1,fixity=Def,priority=9,letBound=True,traced=False})+(Var "undefined",Value{args=0,fixity=Def,priority=9,letBound=True,traced=False})
+ libhx/PreludeReal.hx view
@@ -0,0 +1,239 @@+module Prelude+(Var "!!",Value {args = 2, fixity = L, priority = 9, letBound = True, traced = False})+(Var "$",Value {args = 2, fixity = R, priority = 0, letBound = True, traced = False})+(Var "$!",Value {args = 2, fixity = R, priority = 0, letBound = True, traced = False})+(Var "&&",Value {args = 2, fixity = R, priority = 3, letBound = True, traced = False})+(Var "++",Value {args = 2, fixity = R, priority = 5, letBound = True, traced = False})+(Var ".",Value {args = 3, fixity = R, priority = 9, letBound = True, traced = False})+(Var "=<<",Value {args = 2, fixity = R, priority = 1, letBound = True, traced = False})+(Var "^",Value {args = 2, fixity = R, priority = 8, letBound = True, traced = False})+(Var "^^",Value {args = 2, fixity = R, priority = 8, letBound = True, traced = False})+(Var "_filter",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "_foldr",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "all",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "and",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "any",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "appendFile",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "asTypeOf",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "break",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "catch",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "concat",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "concatMap",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "const",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "curry",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "cycle",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "drop",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "dropWhile",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "either",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "elem",Value {args = 1, fixity = None, priority = 4, letBound = True, traced = False})+(Var "error",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "even",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "filter",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "flip",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "foldl",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "foldl1",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "foldr",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "foldr1",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "fromIntegral",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "fst",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "gcd",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "getChar",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "getContents",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "getLine",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "head",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "id",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "init",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "interact",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "ioError",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "iterate",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "last",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "lcm",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "length",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "lex",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "lines",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "lookup",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "map",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "mapM",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "mapM_",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "maximum",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "maybe",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "minimum",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "not",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "notElem",Value {args = 1, fixity = None, priority = 4, letBound = True, traced = False})+(Var "null",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "odd",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "or",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "otherwise",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "print",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "product",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "putChar",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "putStr",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "putStrLn",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "read",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readFile",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readIO",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readLn",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "readParen",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "reads",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "realToFrac",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "repeat",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "replicate",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "reverse",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "scanl",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "scanl1",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "scanr",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "scanr1",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "seq",Value {args = 2, fixity = R, priority = 0, letBound = True, traced = False})+(Var "sequence",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "sequence_",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showChar",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showParen",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "showString",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "shows",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "snd",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "span",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "splitAt",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "subtract",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "sum",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "tail",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "take",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "takeWhile",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "uncurry",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "undefined",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "unlines",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "until",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "unwords",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "unzip",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "unzip3",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "userError",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "words",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "writeFile",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zip",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zip3",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zipWith",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "zipWith3",Value {args = 4, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "||",Value {args = 2, fixity = R, priority = 2, letBound = True, traced = False})+(Con Data "Bool" "False",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Bool" "True",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Either" "Left",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Either" "Right",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Maybe" "Just",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Maybe" "Nothing",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Ordering" "EQ",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Ordering" "GT",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Ordering" "LT",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Bounded" "maxBound",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Bounded" "minBound",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Enum" "enumFrom",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Enum" "enumFromThen",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Enum" "enumFromThenTo",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Enum" "enumFromTo",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Enum" "fromEnum",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Enum" "pred",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Enum" "succ",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Enum" "toEnum",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Eq" "/=",Value {args = -1, fixity = None, priority = 4, letBound = True, traced = False})+(Method "Eq" "==",Value {args = -1, fixity = None, priority = 4, letBound = True, traced = False})+(Method "Floating" "**",Value {args = -1, fixity = R, priority = 8, letBound = True, traced = False})+(Method "Floating" "acos",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "acosh",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "asin",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "asinh",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "atan",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "atanh",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "cos",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "cosh",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "exp",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "log",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "logBase",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "pi",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "sin",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "sinh",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "sqrt",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "tan",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Floating" "tanh",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Fractional" "/",Value {args = -1, fixity = L, priority = 7, letBound = True, traced = False})+(Method "Fractional" "fromRational",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Fractional" "recip",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Functor" "fmap",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Integral" "div",Value {args = -1, fixity = L, priority = 7, letBound = True, traced = False})+(Method "Integral" "divMod",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Integral" "mod",Value {args = -1, fixity = L, priority = 7, letBound = True, traced = False})+(Method "Integral" "quot",Value {args = -1, fixity = L, priority = 7, letBound = True, traced = False})+(Method "Integral" "quotRem",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Integral" "rem",Value {args = -1, fixity = L, priority = 7, letBound = True, traced = False})+(Method "Integral" "toInteger",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Monad" ">>",Value {args = -1, fixity = L, priority = 1, letBound = True, traced = False})+(Method "Monad" ">>=",Value {args = -1, fixity = L, priority = 1, letBound = True, traced = False})+(Method "Monad" "fail",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Monad" "return",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Num" "*",Value {args = -1, fixity = L, priority = 7, letBound = True, traced = False})+(Method "Num" "+",Value {args = -1, fixity = L, priority = 6, letBound = True, traced = False})+(Method "Num" "-",Value {args = -1, fixity = L, priority = 6, letBound = True, traced = False})+(Method "Num" "abs",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Num" "fromInteger",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Num" "negate",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Num" "signum",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Ord" "<",Value {args = -1, fixity = None, priority = 4, letBound = True, traced = False})+(Method "Ord" "<=",Value {args = -1, fixity = None, priority = 4, letBound = True, traced = False})+(Method "Ord" ">",Value {args = -1, fixity = None, priority = 4, letBound = True, traced = False})+(Method "Ord" ">=",Value {args = -1, fixity = None, priority = 4, letBound = True, traced = False})+(Method "Ord" "compare",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Ord" "max",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Ord" "min",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Read" "readList",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Read" "readsPrec",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Real" "toRational",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "atan2",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "decodeFloat",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "encodeFloat",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "exponent",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "floatDigits",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "floatRadix",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "floatRange",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "isDenormalized",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "isIEEE",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "isInfinite",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "isNaN",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "isNegativeZero",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "scaleFloat",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFloat" "significand",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFrac" "ceiling",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFrac" "floor",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFrac" "properFraction",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFrac" "round",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RealFrac" "truncate",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Show" "show",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Show" "showList",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Show" "showsPrec",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(TypeClass "Bool",TyCls (Ty ["False","True"] []))+(TypeClass "Bounded",TyCls (Cls ["minBound","maxBound"]))+(TypeClass "Char",TyCls (Ty [] []))+(TypeClass "Double",TyCls (Ty [] []))+(TypeClass "Either",TyCls (Ty ["Left","Right"] []))+(TypeClass "Enum",TyCls (Cls ["succ","pred","toEnum","fromEnum","enumFrom","enumFromThen","enumFromTo","enumFromThenTo"]))+(TypeClass "Eq",TyCls (Cls ["==","/="]))+(TypeClass "FilePath",TyCls (Syn 0 THelper))+(TypeClass "Float",TyCls (Ty [] []))+(TypeClass "Floating",TyCls (Cls ["pi","exp","log","sqrt","**","logBase","sin","cos","tan","asin","acos","atan","sinh","cosh","tanh","asinh","acosh","atanh"]))+(TypeClass "Fractional",TyCls (Cls ["/","recip","fromRational"]))+(TypeClass "Functor",TyCls (Cls ["fmap"]))+(TypeClass "IO",TyCls (Ty [] []))+(TypeClass "IOError",TyCls (Ty [] []))+(TypeClass "Int",TyCls (Ty [] []))+(TypeClass "Integer",TyCls (Ty [] []))+(TypeClass "Integral",TyCls (Cls ["quot","rem","div","mod","quotRem","divMod","toInteger"]))+(TypeClass "Maybe",TyCls (Ty ["Nothing","Just"] []))+(TypeClass "Monad",TyCls (Cls [">>=",">>","return","fail"]))+(TypeClass "Num",TyCls (Cls ["+","-","*","negate","abs","signum","fromInteger"]))+(TypeClass "Ord",TyCls (Cls ["compare","<","<=",">=",">","max","min"]))+(TypeClass "Ordering",TyCls (Ty ["LT","EQ","GT"] []))+(TypeClass "Rational",TyCls (Syn 0 THelper))+(TypeClass "Read",TyCls (Cls ["readsPrec","readList"]))+(TypeClass "ReadS",TyCls (Syn 2 (TApp (TApp TFun THelper) THelper)))+(TypeClass "Real",TyCls (Cls ["toRational"]))+(TypeClass "RealFloat",TyCls (Cls ["floatRadix","floatDigits","floatRange","decodeFloat","encodeFloat","exponent","significand","scaleFloat","isNaN","isInfinite","isDenormalized","isNegativeZero","isIEEE","atan2"]))+(TypeClass "RealFrac",TyCls (Cls ["properFraction","truncate","round","ceiling","floor"]))+(TypeClass "Show",TyCls (Cls ["showsPrec","show","showList"]))+(TypeClass "ShowS",TyCls (Syn 2 (TApp (TApp TFun THelper) THelper)))+(TypeClass "String",TyCls (Ty [] []))
+ libhx/Random.hx view
@@ -0,0 +1,18 @@+module Random+(Var "getStdGen",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "getStdRandom",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "mkStdGen",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "newStdGen",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "setStdGen",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Random" "random",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Random" "randomIO",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Random" "randomR",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Random" "randomRIO",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Random" "randomRs",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "Random" "randoms",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RandomGen" "genRange",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RandomGen" "next",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(Method "RandomGen" "split",Value {args = -1, fixity = Def, priority = 9, letBound = True, traced = False})+(TypeClass "Random",TyCls (Cls ["randomR","random","randomRs","randoms","randomRIO","randomIO"]))+(TypeClass "RandomGen",TyCls (Cls ["genRange","next","split"]))+(TypeClass "StdGen",TyCls (Ty [] []))
+ libhx/RandomBuiltin.hx view
@@ -0,0 +1,2 @@+module RandomBuiltin+(TypeClass "StdGen", TyCls (Ty [] []))
+ libhx/Ratio.hx view
@@ -0,0 +1,7 @@+module Ratio+(Var "%",Value {args = 2, fixity = L, priority = 7, letBound = True, traced = False})+(Var "approxRational",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "denominator",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "numerator",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(TypeClass "Ratio",TyCls (Ty [":%"] []))+(TypeClass "Rational",TyCls (Syn 0 THelper))
+ libhx/System.hx view
@@ -0,0 +1,10 @@+module System+(Var "exitFailure",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "exitWith",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "getArgs",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "getEnv",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "getProgName",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "system",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "ExitCode" "ExitFailure",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = True})+(Con Data "ExitCode" "ExitSuccess",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = True})+(TypeClass "ExitCode",TyCls (Ty ["ExitSuccess","ExitFailure"] []))
+ libhx/SystemBuiltin.hx view
@@ -0,0 +1,1 @@+module SystemBuiltin
+ libhx/SystemBuiltinTypes.hx view
@@ -0,0 +1,4 @@+module SystemBuiltinTypes+(Con Data "ExitCode" "ExitFailure",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = True})+(Con Data "ExitCode" "ExitSuccess",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = True})+(TypeClass "ExitCode",TyCls (Ty ["ExitSuccess","ExitFailure"] []))
+ libhx/Time.hx view
@@ -0,0 +1,54 @@+module Time+(Var "addToClockTime",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "calendarTimeToString",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "diffClockTimes",Value {args = 2, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "formatCalendarTime",Value {args = 3, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "getClockTime",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "toCalendarTime",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "toClockTime",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Var "toUTCTime",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "CalendarTime" "CalendarTime",Value {args = 12, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Day" "Friday",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Day" "Monday",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Day" "Saturday",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Day" "Sunday",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Day" "Thursday",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Day" "Tuesday",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Day" "Wednesday",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Month" "April",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Month" "August",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Month" "December",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Month" "February",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Month" "January",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Month" "July",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Month" "June",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Month" "March",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Month" "May",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Month" "November",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Month" "October",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Month" "September",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "TimeDiff" "TimeDiff",Value {args = 7, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "CalendarTime" "ctDay",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "CalendarTime" "ctHour",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "CalendarTime" "ctIsDST",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "CalendarTime" "ctMin",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "CalendarTime" "ctMonth",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "CalendarTime" "ctPicosec",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "CalendarTime" "ctSec",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "CalendarTime" "ctTZ",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "CalendarTime" "ctTZName",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "CalendarTime" "ctWDay",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "CalendarTime" "ctYDay",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "CalendarTime" "ctYear",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "TimeDiff" "tdDay",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "TimeDiff" "tdHour",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "TimeDiff" "tdMin",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "TimeDiff" "tdMonth",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "TimeDiff" "tdPicosec",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "TimeDiff" "tdSec",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "TimeDiff" "tdYear",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(TypeClass "CalendarTime",TyCls (Ty ["CalendarTime"] ["ctYear","ctMonth","ctDay","ctHour","ctMin","ctSec","ctPicosec","ctWDay","ctYDay","ctTZName","ctTZ","ctIsDST"]))+(TypeClass "ClockTime",TyCls (Ty [] []))+(TypeClass "Day",TyCls (Ty ["Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday"] []))+(TypeClass "Month",TyCls (Ty ["January","February","March","April","May","June","July","August","September","October","November","December"] []))+(TypeClass "TimeDiff",TyCls (Ty ["TimeDiff"] ["tdYear","tdMonth","tdDay","tdHour","tdMin","tdSec","tdPicosec"]))
+ libhx/TimeBuiltin.hx view
@@ -0,0 +1,2 @@+module TimeBuiltin+(TypeClass "ClockTime", TyCls (Ty [] []))
+ libhx/TimeBuiltinTypes.hx view
@@ -0,0 +1,45 @@+module TimeBuiltinTypes+(Con Data "CalendarTime" "CalendarTime",Value {args = 12, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Day" "Friday",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Day" "Monday",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Day" "Saturday",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Day" "Sunday",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Day" "Thursday",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Day" "Tuesday",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Day" "Wednesday",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Month" "April",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Month" "August",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Month" "December",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Month" "February",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Month" "January",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Month" "July",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Month" "June",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Month" "March",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Month" "May",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Month" "November",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Month" "October",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "Month" "September",Value {args = 0, fixity = Def, priority = 9, letBound = True, traced = False})+(Con Data "TimeDiff" "TimeDiff",Value {args = 7, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "CalendarTime" "ctDay",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "CalendarTime" "ctHour",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "CalendarTime" "ctIsDST",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "CalendarTime" "ctMin",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "CalendarTime" "ctMonth",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "CalendarTime" "ctPicosec",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "CalendarTime" "ctSec",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "CalendarTime" "ctTZ",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "CalendarTime" "ctTZName",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "CalendarTime" "ctWDay",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "CalendarTime" "ctYDay",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "CalendarTime" "ctYear",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "TimeDiff" "tdDay",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "TimeDiff" "tdHour",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "TimeDiff" "tdMin",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "TimeDiff" "tdMonth",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "TimeDiff" "tdPicosec",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "TimeDiff" "tdSec",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(Field "TimeDiff" "tdYear",Value {args = 1, fixity = Def, priority = 9, letBound = True, traced = False})+(TypeClass "CalendarTime",TyCls (Ty ["CalendarTime"] ["ctYear","ctMonth","ctDay","ctHour","ctMin","ctSec","ctPicosec","ctWDay","ctYDay","ctTZName","ctTZ","ctIsDST"]))+(TypeClass "Day",TyCls (Ty ["Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday"] []))+(TypeClass "Month",TyCls (Ty ["January","February","March","April","May","June","July","August","September","October","November","December"] []))+(TypeClass "TimeDiff",TyCls (Ty ["TimeDiff"] ["tdYear","tdMonth","tdDay","tdHour","tdMin","tdSec","tdPicosec"]))
+ libraries/Array.hs view
@@ -0,0 +1,171 @@+-- this is the very inefficient implementation from the Library report+module  Array ( +    module Ix,  -- export all of Ix +    Array, array, listArray, (!), bounds, indices, elems, assocs, +    accumArray, (//), accum, ixmap ) where++import Ix+import List( (\\) )++infixl 9  !, //++data Array a b = MkArray (a,a) (a -> b) deriving ()  -- no (Ix a) in 2010++array       :: (Ix a) => (a,a) -> [(a,b)] -> Array a b+array b ivs =+    if and [inRange b i | (i,_) <- ivs]+        then MkArray b+                     (\j -> case [v | (i,v) <- ivs, i == j] of+                            [v]   -> v+                            []    -> error "Array.!: \+                                           \undefined array element"+                            _     -> error "Array.!: \+                                           \multiply defined array element")+        else error "Array.array: out-of-range array association"++listArray             :: (Ix a) => (a,a) -> [b] -> Array a b+listArray b vs        =  array b (zipWith (\ a b -> (a,b)) (range b) vs)++(!)                   :: (Ix a) => Array a b -> a -> b+(!) (MkArray _ f)     =  f++bounds                :: (Ix a) => Array a b -> (a,a)+bounds (MkArray b _)  =  b++indices               :: (Ix a) => Array a b -> [a]+indices               =  range . bounds++elems                 :: (Ix a) => Array a b -> [b]+elems a               =  [a!i | i <- indices a]++assocs                :: (Ix a) => Array a b -> [(a,b)]+assocs a              =  [(i, a!i) | i <- indices a]++(//)                  :: (Ix a) => Array a b -> [(a,b)] -> Array a b+a // new_ivs          = array (bounds a) (old_ivs ++ new_ivs)+                      where+                   old_ivs = [(i,a!i) | i <- indices a,+                                             i `notElem` new_is]+                   new_is  = [i | (i,_) <- new_ivs]++accum                 :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)]+                                   -> Array a b+accum f               =  foldl (\a (i,v) -> a // [(i,f (a!i) v)])++accumArray            :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)]+                                   -> Array a b+accumArray f z b      =  accum f (array b [(i,z) | i <- range b])++ixmap                 :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c+                                         -> Array a c+ixmap b f a           = array b [(i, a ! f i) | i <- range b]++instance  (Ix a)          => Functor (Array a) where+    fmap fn (MkArray b f) =  MkArray b (fn . f) ++instance  (Ix a, Eq b)  => Eq (Array a b)  where+    a == a' =  assocs a == assocs a'++instance  (Ix a, Ord b) => Ord (Array a b)  where+    a <= a' =  assocs a <= assocs a'++instance  (Ix a, Show a, Show b) => Show (Array a b)  where+    showsPrec p a = showParen (p > 9) (+                    showString "array " .+                    shows (bounds a) . showChar ' ' .+                    shows (assocs a)                  )++instance  (Ix a, Read a, Read b) => Read (Array a b)  where+    readsPrec p = readParen (p > 9)+           (\r -> [(array b as, u) | ("array",s) <- lex r,+                                     (b,t)       <- reads s,+                                     (as,u)      <- reads t   ])++{-+module  Array ( +    module Ix,  -- export all of Ix +    Array, array, listArray, (!), bounds, indices, elems, assocs, +    accumArray, (//), accum, ixmap ) where++import Ix+import List( (\\) )++infixl 9  !, //++data (Ix a) => Array a b = MkArray (a,a) (a -> b) deriving ()++array       :: (Ix a) => (a,a) -> [(a,b)] -> Array a b+array b ivs = +    if and [inRange b i | (i,_) <- ivs]+        then MkArray b+                     (\j -> case [v | (i,v) <- ivs, index b i == index b j] of+                            [v]   -> v+                            []    -> error "Array.!: \+                                           \undefined array element"+                            _     -> error "Array.!: \+                                           \multiply defined array element")+        else error "Array.array: out-of-range array association"++listArray             :: (Ix a) => (a,a) -> [b] -> Array a b+listArray b vs        =  array b (zipWith (\ a b -> (a,b)) (range b) vs)++(!)                   :: (Ix a) => Array a b -> a -> b+(!) (MkArray _ f)     =  f++bounds                :: (Ix a) => Array a b -> (a,a)+bounds (MkArray b _)  =  b++indices               :: (Ix a) => Array a b -> [a]+indices               =  range . bounds++elems                 :: (Ix a) => Array a b -> [b]+elems a               =  [a!i | i <- indices a]++assocs                :: (Ix a) => Array a b -> [(a,b)]+assocs a              =  [(i, a!i) | i <- indices a]++(//)                  :: (Ix a) => Array a b -> [(a,b)] -> Array a b+a // new_ivs          = array b (old_ivs ++ new_ivs)+                      where+                      b = bounds a+                      old_ivs = [(i,a!i) | i <- indices a,+                                           index b i `notElem` new_is]+                      new_is  = [index b i | (i,_) <- new_ivs]++accum                 :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)]+                                   -> Array a b+accum f               =  foldl (\a (i,v) -> a // [(i,f (a!i) v)])++accumArray            :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)]+                                   -> Array a b+accumArray f z b      =  accum f (array b [(i,z) | i <- range b])++ixmap                 :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c+                                         -> Array a c+ixmap b f a           = array b [(i, a ! f i) | i <- range b]++instance  (Ix a)          => Functor (Array a) where+    fmap fn (MkArray b f) =  MkArray b (fn . f) ++instance  (Ix a, Eq b)  => Eq (Array a b)  where+    a == a' =  assocsInt a == assocsInt a'++instance  (Ix a, Ord b) => Ord (Array a b)  where+    a <= a' =  assocsInt a <= assocsInt a'++assocsInt a = map (\(i,e) -> (index b i,e)) (assocs a)+  where+  b = bounds a++instance  (Ix a, Show a, Show b) => Show (Array a b)  where+    showsPrec p a = showParen (p > 9) (+                    showString "array " .+                    shows (bounds a) . showChar ' ' .+                    shows (assocs a)                  )++instance  (Ix a, Read a, Read b) => Read (Array a b)  where+    readsPrec p = readParen (p > 9)+           (\r -> [(array b as, u) | ("array",s) <- lex r,+                                     (b,t)       <- reads s,+                                     (as,u)      <- reads t   ])+-}
+ libraries/CPUTime.hs view
@@ -0,0 +1,10 @@+module CPUTime ( getCPUTime, cpuTimePrecision ) where++import PreludeBuiltinTypes+import qualified TraceOrigSystem.CPUTime as TraceOrigCPUTime++foreign import haskell "CPUTime.getCPUTime"+ getCPUTime        :: IO Integer++foreign import haskell "CPUTime.cpuTimePrecision"+ cpuTimePrecision  :: Integer
+ libraries/Char.hs view
@@ -0,0 +1,16 @@+--  Wrapper that exports just the stuff normally defined in the +--  standard module Char. +module Char ( +    isAscii, isLatin1, isControl, isPrint, isSpace, isUpper, isLower,+    isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum,+    digitToInt, intToDigit,+    toUpper, toLower,+    ord, chr,+    readLitChar, showLitChar, lexLitChar,++-- ...and what the Prelude exports+    Char, String+    ) where++import PreludeBasic+
+ libraries/Complex.hs view
@@ -0,0 +1,94 @@+module Complex(Complex((:+)), realPart, imagPart, conjugate, mkPolar,+               cis, polar, magnitude, phase)  where++infix  6  :+++data Complex a = !a :+ !a  deriving (Eq,Read,Show) -- no (RealFloat a) in 2010+++realPart, imagPart :: (RealFloat a) => Complex a -> a+realPart (x:+y)  =  x+imagPart (x:+y)  =  y++conjugate  :: (RealFloat a) => Complex a -> Complex a+conjugate (x:+y) =  x :+ (-y)++mkPolar  :: (RealFloat a) => a -> a -> Complex a+mkPolar r theta  =  r * cos theta :+ r * sin theta++cis  :: (RealFloat a) => a -> Complex a+cis theta  =  cos theta :+ sin theta++polar  :: (RealFloat a) => Complex a -> (a,a)+polar z  =  (magnitude z, phase z)++magnitude :: (RealFloat a) => Complex a -> a+magnitude (x:+y) =  scaleFloat k+     (sqrt ((scaleFloat mk x)^(2::Integer) + (scaleFloat mk y)^(2::Integer)))+    where k  = max (exponent x) (exponent y)+          mk = - k++phase :: (RealFloat a) => Complex a -> a+phase (0 :+ 0) = 0+phase (x :+ y) = atan2 y x+++instance  (RealFloat a) => Num (Complex a)  where+    (x:+y) + (x':+y') =  (x+x') :+ (y+y')+    (x:+y) - (x':+y') =  (x-x') :+ (y-y')+    (x:+y) * (x':+y') =  (x*x'-y*y') :+ (x*y'+y*x')+    negate (x:+y) =  negate x :+ negate y+    abs z =  magnitude z :+ 0+    signum 0 =  0+    signum z@(x:+y) =  x/r :+ y/r  where r = magnitude z+    fromInteger n =  fromInteger n :+ 0++instance  (RealFloat a) => Fractional (Complex a)  where+  (x:+y) / (x':+y') =  (x*x''+y*y'') / d :+ (y*x''-x*y'') / d+    where +    x'' = scaleFloat k x'+    y'' = scaleFloat k y'+    k   = - max (exponent x') (exponent y')+    d   = x'*x'' + y'*y''++  fromRational a =  fromRational a :+ 0++instance  (RealFloat a) => Floating (Complex a) where+    pi             =  pi :+ 0+    exp (x:+y)     =  expx * cos y :+ expx * sin y+                      where expx = exp x+    log z          =  log (magnitude z) :+ phase z++    sqrt 0         =  0+    sqrt z@(x:+y)  =  u :+ (if y < 0 then -v else v)+                      where (u,v) = if x < 0 then (v',u') else (u',v')+                            v'    = abs y / (u'*2)+                            u'    = sqrt ((magnitude z + abs x) / 2)++    sin (x:+y)     =  sin x * cosh y :+ cos x * sinh y+    cos (x:+y)     =  cos x * cosh y :+ (- sin x * sinh y)+    tan (x:+y)     =  (sinx*coshy:+cosx*sinhy)/(cosx*coshy:+(-sinx*sinhy))+                      where sinx  = sin x+                            cosx  = cos x+                            sinhy = sinh y+                            coshy = cosh y++    sinh (x:+y)    =  cos y * sinh x :+ sin  y * cosh x+    cosh (x:+y)    =  cos y * cosh x :+ sin y * sinh x+    tanh (x:+y)    =  (cosy*sinhx:+siny*coshx)/(cosy*coshx:+siny*sinhx)+                      where siny  = sin y+                            cosy  = cos y+                            sinhx = sinh x+                            coshx = cosh x++    asin z@(x:+y)  =  y':+(-x')+                      where  (x':+y') = log (((-y):+x) + sqrt (1 - z*z))+    acos z@(x:+y)  =  y'':+(-x'')+                      where (x'':+y'') = log (z + ((-y'):+x'))+                            (x':+y')   = sqrt (1 - z*z)+    atan z@(x:+y)  =  y':+(-x')+                      where (x':+y') = log (((1-y):+x) / sqrt (1+z*z))++    asinh z        =  log (z + sqrt (1+z*z))+    acosh z        =  log (z + (z+1) * sqrt ((z-1)/(z+1)))+    atanh z        =  log ((1+z) / sqrt (1-z*z))
+ libraries/Directory.hs view
@@ -0,0 +1,75 @@+module Directory ( +     Permissions( Permissions, readable, writable, executable, searchable ), +     createDirectory, removeDirectory, removeFile, +     renameDirectory, renameFile, getDirectoryContents,+     getCurrentDirectory, setCurrentDirectory,+     doesFileExist, doesDirectoryExist,+     getPermissions, setPermissions,+     getModificationTime ) where++import Time ( ClockTime )+import PreludeBuiltinTypes+import DirectoryBuiltinTypes+import DirectoryBuiltin+import TimeBuiltin+import qualified TraceOrigSystem.Directory as TraceOrigDirectory++instance Eq   Permissions where +  (==) = primPermissionsEq++instance Ord  Permissions where +  compare = primPermissionsCompare+  (<=) = primPermissionsLeEq++instance Read Permissions where +  readsPrec = primPermissionsReadsPrec++instance Show Permissions where+  showsPrec = primPermissionsShowsPrec++foreign import haskell "Prelude.=="+ primPermissionsEq :: Permissions -> Permissions -> Bool++foreign import haskell "Prelude.compare"+ primPermissionsCompare :: Permissions -> Permissions -> Ordering++foreign import haskell "Prelude.<="+ primPermissionsLeEq :: Permissions -> Permissions -> Bool++foreign import haskell "Prelude.readsPrec"+ primPermissionsReadsPrec :: Int -> String -> [(Permissions,String)]++foreign import haskell "Prelude.showsPrec"+ primPermissionsShowsPrec :: Int -> Permissions -> String -> String+++foreign import haskell "Directory.createDirectory"+ createDirectory  :: String -> IO ()+foreign import haskell "Directory.removeDirectory"+ removeDirectory  :: String -> IO ()+foreign import haskell "Directory.removeFile"+ removeFile  :: String -> IO ()+foreign import haskell "Directory.renameDirectory"+ renameDirectory  :: String -> String -> IO ()+foreign import haskell "Directory.renameFile"+ renameFile  :: String -> String -> IO ()++foreign import haskell "Directory.getDirectoryContents"+ getDirectoryContents  :: String -> IO [String]+foreign import haskell "Directory.getCurrentDirectory"+ getCurrentDirectory  :: IO String+foreign import haskell "Directory.setCurrentDirectory"+ setCurrentDirectory  :: String -> IO ()++foreign import haskell "Directory.doesFileExist"+ doesFileExist :: String -> IO Bool+foreign import haskell "Directory.doesDirectoryExist"+ doesDirectoryExist :: String -> IO Bool++foreign import haskell "Directory.getPermissions"+ getPermissions :: String -> IO Permissions+foreign import haskell "Directory.setPermissions"+ setPermissions :: String -> Permissions -> IO ()++foreign import haskell "Directory.getModificationTime"+ getModificationTime :: String -> IO ClockTime
+ libraries/DirectoryBuiltinTypes.hs view
@@ -0,0 +1,6 @@+module DirectoryBuiltinTypes where++data Permissions = Permissions {+ readable,   writable,+ executable, searchable :: Bool+    }
+ libraries/IO.hs view
@@ -0,0 +1,185 @@+module IO (+     Handle, HandlePosn,+     IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),+     BufferMode(NoBuffering,LineBuffering,BlockBuffering),+     SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),+     stdin, stdout, stderr, +     openFile, hClose, hFileSize, hIsEOF, isEOF,+     hSetBuffering, hGetBuffering, hFlush, +     hGetPosn, hSetPosn, hSeek, +     hWaitForInput, hReady, hGetChar, hGetLine, hLookAhead, hGetContents, +     hPutChar, hPutStr, hPutStrLn, hPrint,+     hIsOpen, hIsClosed, hIsReadable, hIsWritable, hIsSeekable,+     isAlreadyExistsError, isDoesNotExistError, isAlreadyInUseError, +     isFullError, isEOFError,+     isIllegalOperation, isPermissionError, isUserError, +     ioeGetErrorString, ioeGetHandle, ioeGetFileName,+     try, bracket, bracket_,++     -- ...and what the Prelude exports+     IO, FilePath, IOError, ioError, userError, catch, interact,+     putChar, putStr, putStrLn, print, getChar, getLine, getContents,+     readFile, writeFile, appendFile, readIO, readLn+     ) where++import Ix(Ix(range, index, inRange))+import PreludeBuiltinTypes+import TraceOrigSystem.IO(Handle,HandlePosn)+import qualified TraceOrigSystem.IO as TraceOrigIO+import qualified TraceOrigSystem.IO.Error as TraceOrigError+import IOBuiltinTypes+import IOBuiltin++-- data Handle = ... -- implementation-dependent+++foreign import haskell "Prelude.=="+ primHandleEq :: Handle -> Handle -> Bool++foreign import haskell "Prelude.showsPrec"+ primHandleShowsPrec :: Int -> Handle -> String -> String++instance Eq Handle where +  (==) = primHandleEq++instance Show Handle where +  showsPrec = primHandleShowsPrec++-- data HandlePosn = ... -- implementation-dependent++foreign import haskell "Prelude.=="+ primHandlePosnEq :: HandlePosn -> HandlePosn -> Bool++instance Eq HandlePosn where +  (==) = primHandlePosnEq++{- not implemented in GHC 5.02+foreign import haskell "Prelude.showsPrec"+ primHandlePosnShowsPrec :: Int -> HandlePosn -> String -> String++instance Show HandlePosn where+  showsPrec = primHandlePosnShowsPrec+-}+++foreign import haskell "IO.stdin"+ stdin :: Handle+foreign import haskell "IO.stdout"+ stdout :: Handle+foreign import haskell "IO.stderr"+ stderr :: Handle++foreign import haskell "IO.openFile"+ openFile              :: String -> IOMode -> IO Handle+foreign import haskell "IO.hClose"+ hClose                :: Handle -> IO ()++foreign import haskell "IO.hFileSize"+ hFileSize             :: Handle -> IO Integer+foreign import haskell "IO.hIsEOF"+ hIsEOF                :: Handle -> IO Bool++isEOF                 :: IO Bool+isEOF                 =  hIsEOF stdin++foreign import haskell "IO.hSetBuffering"+ hSetBuffering         :: Handle  -> BufferMode -> IO ()+foreign import haskell "IO.hGetBuffering"+ hGetBuffering         :: Handle  -> IO BufferMode+foreign import haskell "IO.hFlush"+ hFlush                :: Handle -> IO () +foreign import haskell "IO.hGetPosn"+ hGetPosn              :: Handle -> IO HandlePosn+foreign import haskell "IO.hSetPosn"+ hSetPosn              :: HandlePosn -> IO () +foreign import haskell "IO.hSeek"+ hSeek                 :: Handle -> SeekMode -> Integer -> IO () ++foreign import haskell "IO.hWaitForInput"+ hWaitForInput       :: Handle -> Int -> IO Bool++hReady :: Handle -> IO Bool +hReady h = hWaitForInput h 0++foreign import haskell "IO.hGetChar"+ hGetChar              :: Handle -> IO Char+foreign import haskell "IO.hGetLine"+ hGetLine              :: Handle -> IO String+foreign import haskell "IO.hLookAhead"+ hLookAhead            :: Handle -> IO Char+foreign import haskell "IO.hGetContents"+ hGetContents          :: Handle -> IO String+foreign import haskell "(\\_ h c -> T.outputTrace khPutChar [c] Prelude.>> IO.hPutChar h c) Prelude.True"+ hPutChar              :: Handle -> Char -> IO ()+foreign import haskell "(\\_ h s -> T.outputTrace khPutStr s Prelude.>> IO.hPutStr h s) Prelude.True"+ hPutStr               :: Handle -> String -> IO () ++hPutStrLn         :: Handle -> String -> IO ()+hPutStrLn h s     =  do hPutStr h s+                        hPutStr h "\n"++hPrint     :: Show a => Handle -> a -> IO ()+hPrint h x = hPutStrLn h (show x)++foreign import haskell "IO.hIsOpen"+ hIsOpen               :: Handle -> IO Bool+foreign import haskell "IO.hIsClosed"+ hIsClosed             :: Handle -> IO Bool+foreign import haskell "IO.hIsReadable"+ hIsReadable           :: Handle -> IO Bool+foreign import haskell "IO.hIsWritable"+ hIsWritable           :: Handle -> IO Bool+foreign import haskell "IO.hIsSeekable"+ hIsSeekable           :: Handle -> IO Bool++foreign import haskell "Error.isAlreadyExistsError"+ isAlreadyExistsError  :: IOError -> Bool+foreign import haskell "Error.isDoesNotExistError"+ isDoesNotExistError   :: IOError -> Bool +foreign import haskell "Error.isAlreadyInUseError"+ isAlreadyInUseError   :: IOError -> Bool+foreign import haskell "Error.isFullError"+ isFullError           :: IOError -> Bool+foreign import haskell "Error.isEOFError"+ isEOFError            :: IOError -> Bool+foreign import haskell "Error.isIllegalOperation"+ isIllegalOperation    :: IOError -> Bool+foreign import haskell "Error.isPermissionError"+ isPermissionError     :: IOError -> Bool+foreign import haskell "Error.isUserError"+ isUserError           :: IOError -> Bool++foreign import haskell "Error.ioeGetErrorString"+ ioeGetErrorString     :: IOError -> String+foreign import haskell "Error.ioeGetHandle"+ ioeGetHandle          :: IOError -> Maybe Handle++foreign import haskell "Error.ioeGetFileName"+ ioeGetFileName        :: IOError -> Maybe String++-- Just provide an implementation of the system-indendent+-- actions that IO exports.++try            :: IO a -> IO (Either IOError a)+try f          =  catch (do r <- f+                            return (Right r))+                        (return . Left)++bracket        :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c+bracket before after m = do+        x  <- before+        rs <- try (m x)+        after x+        case rs of+           Right r -> return r+           Left  e -> ioError e++-- variant of the above where middle computation doesn't want x+bracket_        :: IO a -> (a -> IO b) -> IO c -> IO c+bracket_ before after m = do+         x  <- before+         rs <- try m+         after x+         case rs of+            Right r -> return r+            Left  e -> ioError e
+ libraries/IOBuiltinTypes.hs view
@@ -0,0 +1,11 @@+module IOBuiltinTypes where++import Ix(Ix(..))++data IOMode      =  ReadMode | WriteMode | AppendMode | ReadWriteMode+                     deriving (Eq, Ord, Ix, Bounded, Enum, Read, Show)+data BufferMode  =  NoBuffering | LineBuffering +                  |  BlockBuffering (Maybe Int)+                     deriving (Eq, Ord, Read, Show)+data SeekMode    =  AbsoluteSeek | RelativeSeek | SeekFromEnd+                     deriving (Eq, Ord, Ix, Bounded, Enum, Read, Show)
+ libraries/Ix.hs view
@@ -0,0 +1,570 @@+module Ix ( Ix(range, index, inRange, rangeSize) ) where++class Ord a => Ix a  where+    range     :: (a,a) -> [a]+    index     :: (a,a) -> a -> Int+    inRange   :: (a,a) -> a -> Bool+    rangeSize :: (a,a) -> Int++    rangeSize b@(l,h) | null (range b) = 0+                      | otherwise      = index b h + 1 +-- NB: replacing "null (range b)" by  "not (l <= h)"+-- fails if the bounds are tuples.  For example,+--  (1,2) <= (2,1)+-- but the range is nevertheless empty+-- range ((1,2),(2,1)) = []++instance  Ix Char  where+    range (m,n) = [m..n]+    index b@(c,c') ci+        | inRange b ci  =  fromEnum ci - fromEnum c+        | otherwise     =  error "Ix.index: Index out of range."+    inRange (c,c') i    =  c <= i && i <= c'++instance  Ix Int  where+    range (m,n) = [m..n]+    index b@(m,n) i+        | inRange b i   =  i - m+        | otherwise     =  error "Ix.index: Index out of range."+    inRange (m,n) i     =  m <= i && i <= n++instance  Ix Integer  where+    range (m,n) = [m..n]+    index b@(m,n) i+        | inRange b i   =  fromInteger (i - m)+        | otherwise     =  error "Ix.index: Index out of range."+    inRange (m,n) i     =  m <= i && i <= n++instance Ix Bool where+  range (c,c') 	= [c .. c']++  index b@(c,c') ci+	| inRange b ci = fromEnum ci - fromEnum c+	| True         = error "Ix.Bool.index: Index out of range."+  inRange (c,c') ci    = c <= ci && ci <= c'  +  -- Assuming Enum and Ord agree on order for Bool++instance Ix Ordering where+  range (c,c') 	= [c .. c']++  index b@(c,c') ci+	| inRange b ci = fromEnum ci - fromEnum c+	| True         = error "Ix.Ordering.index: Index out of range."+  inRange (c,c') ci    = c <= ci && ci <= c'  +  -- Assuming Enum and Ord agree on order for Ordering++instance Ix () where+  range ((),()) = [()]+  index ((),()) () = 0+  inRange ((),()) () = True++instance  (Ix a, Ix b)  => Ix (a,b) where+         range ((l,l'),(u,u'))+                 = [(i,i') | i <- range (l,u), i' <- range (l',u')]+         index ((l,l'),(u,u')) (i,i')+                 =  index (l,u) i * rangeSize (l',u') + index (l',u') i'+         inRange ((l,l'),(u,u')) (i,i')+                 = inRange (l,u) i && inRange (l',u') i'++instance  (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3)  where+    range ((l1,l2,l3),(u1,u2,u3)) =+          [(i1,i2,i3) | i1 <- range (l1,u1),+                        i2 <- range (l2,u2),+                        i3 <- range (l3,u3)]++    index ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =+        index (l3,u3) i3 + rangeSize (l3,u3) * (+         index (l2,u2) i2 + rangeSize (l2,u2) * (+           index (l1,u1) i1))++    inRange ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =+         inRange (l1,u1) i1+           && inRange (l2,u2) i2+           && inRange (l3,u3) i3++instance  (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4)  where+    range ((l1,l2,l3,l4),(u1,u2,u3,u4)) =+          [(i1,i2,i3,i4) | i1 <- range (l1,u1),+                           i2 <- range (l2,u2),+                           i3 <- range (l3,u3),+                           i4 <- range (l4,u4)]++    index ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =+        index (l4,u4) i4 + rangeSize (l4,u4) * (+         index (l3,u3) i3 + rangeSize (l3,u3) * (+           index (l2,u2) i2 + rangeSize (l2,u2) * (+             index (l1,u1) i1)))++    inRange ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =+         inRange (l1,u1) i1+           && inRange (l2,u2) i2+           && inRange (l3,u3) i3+           && inRange (l4,u4) i4++instance  (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) =>+	 Ix (a1,a2,a3,a4,a5)  where+    range ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) =+          [(i1,i2,i3,i4,i5) | i1 <- range (l1,u1),+                              i2 <- range (l2,u2),+                              i3 <- range (l3,u3),+                              i4 <- range (l4,u4),+                              i5 <- range (l5,u5)]++    index ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =+        index (l5,u5) i5 + rangeSize (l5,u5) * (+         index (l4,u4) i4 + rangeSize (l4,u4) * (+          index (l3,u3) i3 + rangeSize (l3,u3) * (+           index (l2,u2) i2 + rangeSize (l2,u2) * (+            index (l1,u1) i1))))++    inRange ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =+         inRange (l1,u1) i1+           && inRange (l2,u2) i2+           && inRange (l3,u3) i3+           && inRange (l4,u4) i4+           && inRange (l5,u5) i5++instance  (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5, Ix a6) =>+	 Ix (a1,a2,a3,a4,a5,a6)  where+    range ((l1,l2,l3,l4,l5,l6),(u1,u2,u3,u4,u5,u6)) =+          [(i1,i2,i3,i4,i5,i6) | i1 <- range (l1,u1),+                                 i2 <- range (l2,u2),+                                 i3 <- range (l3,u3),+                                 i4 <- range (l4,u4),+                                 i5 <- range (l5,u5),+                                 i6 <- range (l6,u6)]++    index ((l1,l2,l3,l4,l5,l6),(u1,u2,u3,u4,u5,u6)) (i1,i2,i3,i4,i5,i6) =+        index (l6,u6) i6 + rangeSize (l6,u6) * (+         index (l5,u5) i5 + rangeSize (l5,u5) * (+          index (l4,u4) i4 + rangeSize (l4,u4) * (+           index (l3,u3) i3 + rangeSize (l3,u3) * (+            index (l2,u2) i2 + rangeSize (l2,u2) * (+             index (l1,u1) i1)))))++    inRange ((l1,l2,l3,l4,l5,l6),(u1,u2,u3,u4,u5,u6)) (i1,i2,i3,i4,i5,i6) =+         inRange (l1,u1) i1+           && inRange (l2,u2) i2+           && inRange (l3,u3) i3+           && inRange (l4,u4) i4+           && inRange (l5,u5) i5+           && inRange (l6,u6) i6++instance  (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5, Ix a6, Ix a7) =>+	 Ix (a1,a2,a3,a4,a5,a6,a7)  where+    range ((l1,l2,l3,l4,l5,l6,l7),(u1,u2,u3,u4,u5,u6,u7)) =+          [(i1,i2,i3,i4,i5,i6,i7) | i1 <- range (l1,u1),+                                    i2 <- range (l2,u2),+                                    i3 <- range (l3,u3),+                                    i4 <- range (l4,u4),+                                    i5 <- range (l5,u5),+                                    i6 <- range (l6,u6),+                                    i7 <- range (l7,u7)]++    index ((l1,l2,l3,l4,l5,l6,l7),(u1,u2,u3,u4,u5,u6,u7)) (i1,i2,i3,i4,i5,i6,i7) =+       index (l7,u7) i7 + rangeSize (l7,u7) * (+        index (l6,u6) i6 + rangeSize (l6,u6) * (+         index (l5,u5) i5 + rangeSize (l5,u5) * (+          index (l4,u4) i4 + rangeSize (l4,u4) * (+           index (l3,u3) i3 + rangeSize (l3,u3) * (+            index (l2,u2) i2 + rangeSize (l2,u2) * (+             index (l1,u1) i1))))))++    inRange ((l1,l2,l3,l4,l5,l6,l7),(u1,u2,u3,u4,u5,u6,u7)) (i1,i2,i3,i4,i5,i6,i7) =+         inRange (l1,u1) i1+           && inRange (l2,u2) i2+           && inRange (l3,u3) i3+           && inRange (l4,u4) i4+           && inRange (l5,u5) i5+           && inRange (l6,u6) i6+           && inRange (l7,u7) i7++instance  (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5, Ix a6, Ix a7, Ix a8) =>+	 Ix (a1,a2,a3,a4,a5,a6,a7,a8)  where+    range ((l1,l2,l3,l4,l5,l6,l7,l8),(u1,u2,u3,u4,u5,u6,u7,u8)) =+          [(i1,i2,i3,i4,i5,i6,i7,i8) | i1 <- range (l1,u1),+                                    i2 <- range (l2,u2),+                                    i3 <- range (l3,u3),+                                    i4 <- range (l4,u4),+                                    i5 <- range (l5,u5),+                                    i6 <- range (l6,u6),+                                    i7 <- range (l7,u7),+                                    i8 <- range (l8,u8)]++    index ((l1,l2,l3,l4,l5,l6,l7,l8),(u1,u2,u3,u4,u5,u6,u7,u8))+          (i1,i2,i3,i4,i5,i6,i7,i8) =+       index (l8,u8) i8 + rangeSize (l8,u8) * (+        index (l7,u7) i7 + rangeSize (l7,u7) * (+         index (l6,u6) i6 + rangeSize (l6,u6) * (+          index (l5,u5) i5 + rangeSize (l5,u5) * (+           index (l4,u4) i4 + rangeSize (l4,u4) * (+            index (l3,u3) i3 + rangeSize (l3,u3) * (+             index (l2,u2) i2 + rangeSize (l2,u2) * (+              index (l1,u1) i1)))))))++    inRange ((l1,l2,l3,l4,l5,l6,l7,l8),(u1,u2,u3,u4,u5,u6,u7,u8))+            (i1,i2,i3,i4,i5,i6,i7,i8) =+         inRange (l1,u1) i1+           && inRange (l2,u2) i2+           && inRange (l3,u3) i3+           && inRange (l4,u4) i4+           && inRange (l5,u5) i5+           && inRange (l6,u6) i6+           && inRange (l7,u7) i7+           && inRange (l8,u8) i8++instance  (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5, Ix a6, Ix a7, Ix a8, Ix a9) =>+	 Ix (a1,a2,a3,a4,a5,a6,a7,a8,a9)  where+    range ((l1,l2,l3,l4,l5,l6,l7,l8,l9),(u1,u2,u3,u4,u5,u6,u7,u8,u9)) =+          [(i1,i2,i3,i4,i5,i6,i7,i8,i9)+			 | i1 <- range (l1,u1),+                           i2 <- range (l2,u2),+                           i3 <- range (l3,u3),+                           i4 <- range (l4,u4),+                           i5 <- range (l5,u5),+                           i6 <- range (l6,u6),+                           i7 <- range (l7,u7),+                           i8 <- range (l8,u8),+                           i9 <- range (l9,u9)]++    index ((l1,l2,l3,l4,l5,l6,l7,l8,l9),(u1,u2,u3,u4,u5,u6,u7,u8,u9))+          (i1,i2,i3,i4,i5,i6,i7,i8,i9) =+            index (l9,u9) i9 + rangeSize (l9,u9) * (+             index (l8,u8) i8 + rangeSize (l8,u8) * (+              index (l7,u7) i7 + rangeSize (l7,u7) * (+               index (l6,u6) i6 + rangeSize (l6,u6) * (+                index (l5,u5) i5 + rangeSize (l5,u5) * (+                 index (l4,u4) i4 + rangeSize (l4,u4) * (+                  index (l3,u3) i3 + rangeSize (l3,u3) * (+                   index (l2,u2) i2 + rangeSize (l2,u2) * (+                    index (l1,u1) i1))))))))++    inRange ((l1,l2,l3,l4,l5,l6,l7,l8,l9),(u1,u2,u3,u4,u5,u6,u7,u8,u9))+            (i1,i2,i3,i4,i5,i6,i7,i8,i9) =+         inRange (l1,u1) i1+           && inRange (l2,u2) i2+           && inRange (l3,u3) i3+           && inRange (l4,u4) i4+           && inRange (l5,u5) i5+           && inRange (l6,u6) i6+           && inRange (l7,u7) i7+           && inRange (l8,u8) i8+           && inRange (l9,u9) i9++instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5, Ix a6, Ix a7, Ix a8, Ix a9+	 ,Ix a10) =>+	 Ix (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10)  where+    range ((l1,l2,l3,l4,l5,l6,l7,l8,l9,l10)+	  ,(u1,u2,u3,u4,u5,u6,u7,u8,u9,u10)) =+          [(i1,i2,i3,i4,i5,i6,i7,i8,i9,i10)+			 | i1 <- range (l1,u1),+                           i2 <- range (l2,u2),+                           i3 <- range (l3,u3),+                           i4 <- range (l4,u4),+                           i5 <- range (l5,u5),+                           i6 <- range (l6,u6),+                           i7 <- range (l7,u7),+                           i8 <- range (l8,u8),+                           i9 <- range (l9,u9),+                           i10 <- range (l10,u10)]++    index ((l1,l2,l3,l4,l5,l6,l7,l8,l9,l10)+	  ,(u1,u2,u3,u4,u5,u6,u7,u8,u9,u10))+          (i1,i2,i3,i4,i5,i6,i7,i8,i9,i10) =+           index (l10,u10) i10 + rangeSize (l10,u10) * (+            index (l9,u9) i9 + rangeSize (l9,u9) * (+             index (l8,u8) i8 + rangeSize (l8,u8) * (+              index (l7,u7) i7 + rangeSize (l7,u7) * (+               index (l6,u6) i6 + rangeSize (l6,u6) * (+                index (l5,u5) i5 + rangeSize (l5,u5) * (+                 index (l4,u4) i4 + rangeSize (l4,u4) * (+                  index (l3,u3) i3 + rangeSize (l3,u3) * (+                   index (l2,u2) i2 + rangeSize (l2,u2) * (+                    index (l1,u1) i1)))))))))++    inRange ((l1,l2,l3,l4,l5,l6,l7,l8,l9,l10)+	    ,(u1,u2,u3,u4,u5,u6,u7,u8,u9,u10))+            (i1,i2,i3,i4,i5,i6,i7,i8,i9,i10) =+         inRange (l1,u1) i1+           && inRange (l2,u2) i2+           && inRange (l3,u3) i3+           && inRange (l4,u4) i4+           && inRange (l5,u5) i5+           && inRange (l6,u6) i6+           && inRange (l7,u7) i7+           && inRange (l8,u8) i8+           && inRange (l9,u9) i9+           && inRange (l10,u10) i10++instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5, Ix a6, Ix a7, Ix a8, Ix a9+	 ,Ix a10, Ix a11) =>+	 Ix (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11)  where+    range ((l1,l2,l3,l4,l5,l6,l7,l8,l9,l10,l11)+	  ,(u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11)) =+          [(i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11)+			 | i1 <- range (l1,u1),+                           i2 <- range (l2,u2),+                           i3 <- range (l3,u3),+                           i4 <- range (l4,u4),+                           i5 <- range (l5,u5),+                           i6 <- range (l6,u6),+                           i7 <- range (l7,u7),+                           i8 <- range (l8,u8),+                           i9 <- range (l9,u9),+                           i10 <- range (l10,u10),+                           i11 <- range (l11,u11)]++    index ((l1,l2,l3,l4,l5,l6,l7,l8,l9,l10,l11)+	  ,(u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11))+          (i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11) =+          index (l11,u11) i11 + rangeSize (l11,u11) * (+           index (l10,u10) i10 + rangeSize (l10,u10) * (+            index (l9,u9) i9 + rangeSize (l9,u9) * (+             index (l8,u8) i8 + rangeSize (l8,u8) * (+              index (l7,u7) i7 + rangeSize (l7,u7) * (+               index (l6,u6) i6 + rangeSize (l6,u6) * (+                index (l5,u5) i5 + rangeSize (l5,u5) * (+                 index (l4,u4) i4 + rangeSize (l4,u4) * (+                  index (l3,u3) i3 + rangeSize (l3,u3) * (+                   index (l2,u2) i2 + rangeSize (l2,u2) * (+                    index (l1,u1) i1))))))))))++    inRange ((l1,l2,l3,l4,l5,l6,l7,l8,l9,l10,l11)+	    ,(u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11))+            (i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11) =+         inRange (l1,u1) i1+           && inRange (l2,u2) i2+           && inRange (l3,u3) i3+           && inRange (l4,u4) i4+           && inRange (l5,u5) i5+           && inRange (l6,u6) i6+           && inRange (l7,u7) i7+           && inRange (l8,u8) i8+           && inRange (l9,u9) i9+           && inRange (l10,u10) i10+           && inRange (l11,u11) i11++instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5, Ix a6, Ix a7, Ix a8, Ix a9+	 ,Ix a10, Ix a11, Ix a12) =>+	 Ix (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12)  where+    range ((l1,l2,l3,l4,l5,l6,l7,l8,l9,l10,l11,l12)+	  ,(u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12)) =+          [(i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12)+			 | i1 <- range (l1,u1),+                           i2 <- range (l2,u2),+                           i3 <- range (l3,u3),+                           i4 <- range (l4,u4),+                           i5 <- range (l5,u5),+                           i6 <- range (l6,u6),+                           i7 <- range (l7,u7),+                           i8 <- range (l8,u8),+                           i9 <- range (l9,u9),+                           i10 <- range (l10,u10),+                           i11 <- range (l11,u11),+                           i12 <- range (l12,u12)]++    index ((l1,l2,l3,l4,l5,l6,l7,l8,l9,l10,l11,l12)+	  ,(u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12))+          (i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12) =+         index (l12,u12) i12 + rangeSize (l12,u12) * (+          index (l11,u11) i11 + rangeSize (l11,u11) * (+           index (l10,u10) i10 + rangeSize (l10,u10) * (+            index (l9,u9) i9 + rangeSize (l9,u9) * (+             index (l8,u8) i8 + rangeSize (l8,u8) * (+              index (l7,u7) i7 + rangeSize (l7,u7) * (+               index (l6,u6) i6 + rangeSize (l6,u6) * (+                index (l5,u5) i5 + rangeSize (l5,u5) * (+                 index (l4,u4) i4 + rangeSize (l4,u4) * (+                  index (l3,u3) i3 + rangeSize (l3,u3) * (+                   index (l2,u2) i2 + rangeSize (l2,u2) * (+                    index (l1,u1) i1)))))))))))++    inRange ((l1,l2,l3,l4,l5,l6,l7,l8,l9,l10,l11,l12)+	    ,(u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12))+            (i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12) =+         inRange (l1,u1) i1+           && inRange (l2,u2) i2+           && inRange (l3,u3) i3+           && inRange (l4,u4) i4+           && inRange (l5,u5) i5+           && inRange (l6,u6) i6+           && inRange (l7,u7) i7+           && inRange (l8,u8) i8+           && inRange (l9,u9) i9+           && inRange (l10,u10) i10+           && inRange (l11,u11) i11+           && inRange (l12,u12) i12++instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5, Ix a6, Ix a7, Ix a8, Ix a9+	 ,Ix a10, Ix a11, Ix a12, Ix a13) =>+	 Ix (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13)  where+    range ((l1,l2,l3,l4,l5,l6,l7,l8,l9,l10,l11,l12,l13)+	  ,(u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13)) =+          [(i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12,i13)+			 | i1 <- range (l1,u1),+                           i2 <- range (l2,u2),+                           i3 <- range (l3,u3),+                           i4 <- range (l4,u4),+                           i5 <- range (l5,u5),+                           i6 <- range (l6,u6),+                           i7 <- range (l7,u7),+                           i8 <- range (l8,u8),+                           i9 <- range (l9,u9),+                           i10 <- range (l10,u10),+                           i11 <- range (l11,u11),+                           i12 <- range (l12,u12),+                           i13 <- range (l13,u13)]++    index ((l1,l2,l3,l4,l5,l6,l7,l8,l9,l10,l11,l12,l13)+	  ,(u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13))+          (i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12,i13) =+        index (l13,u13) i13 + rangeSize (l13,u13) * (+         index (l12,u12) i12 + rangeSize (l12,u12) * (+          index (l11,u11) i11 + rangeSize (l11,u11) * (+           index (l10,u10) i10 + rangeSize (l10,u10) * (+            index (l9,u9) i9 + rangeSize (l9,u9) * (+             index (l8,u8) i8 + rangeSize (l8,u8) * (+              index (l7,u7) i7 + rangeSize (l7,u7) * (+               index (l6,u6) i6 + rangeSize (l6,u6) * (+                index (l5,u5) i5 + rangeSize (l5,u5) * (+                 index (l4,u4) i4 + rangeSize (l4,u4) * (+                  index (l3,u3) i3 + rangeSize (l3,u3) * (+                   index (l2,u2) i2 + rangeSize (l2,u2) * (+                    index (l1,u1) i1))))))))))))++    inRange ((l1,l2,l3,l4,l5,l6,l7,l8,l9,l10,l11,l12,l13)+	    ,(u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13))+            (i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12,i13) =+         inRange (l1,u1) i1+           && inRange (l2,u2) i2+           && inRange (l3,u3) i3+           && inRange (l4,u4) i4+           && inRange (l5,u5) i5+           && inRange (l6,u6) i6+           && inRange (l7,u7) i7+           && inRange (l8,u8) i8+           && inRange (l9,u9) i9+           && inRange (l10,u10) i10+           && inRange (l11,u11) i11+           && inRange (l12,u12) i12+           && inRange (l13,u13) i13++instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5, Ix a6, Ix a7, Ix a8, Ix a9+	 ,Ix a10, Ix a11, Ix a12, Ix a13, Ix a14) =>+	 Ix (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14)  where+    range ((l1,l2,l3,l4,l5,l6,l7,l8,l9,l10,l11,l12,l13,l14)+	  ,(u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14)) =+          [(i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12,i13,i14)+			 | i1 <- range (l1,u1),+                           i2 <- range (l2,u2),+                           i3 <- range (l3,u3),+                           i4 <- range (l4,u4),+                           i5 <- range (l5,u5),+                           i6 <- range (l6,u6),+                           i7 <- range (l7,u7),+                           i8 <- range (l8,u8),+                           i9 <- range (l9,u9),+                           i10 <- range (l10,u10),+                           i11 <- range (l11,u11),+                           i12 <- range (l12,u12),+                           i13 <- range (l13,u13),+                           i14 <- range (l14,u14)]++    index ((l1,l2,l3,l4,l5,l6,l7,l8,l9,l10,l11,l12,l13,l14)+	  ,(u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14))+          (i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12,i13,i14) =+       index (l14,u14) i14 + rangeSize (l14,u14) * (+        index (l13,u13) i13 + rangeSize (l13,u13) * (+         index (l12,u12) i12 + rangeSize (l12,u12) * (+          index (l11,u11) i11 + rangeSize (l11,u11) * (+           index (l10,u10) i10 + rangeSize (l10,u10) * (+            index (l9,u9) i9 + rangeSize (l9,u9) * (+             index (l8,u8) i8 + rangeSize (l8,u8) * (+              index (l7,u7) i7 + rangeSize (l7,u7) * (+               index (l6,u6) i6 + rangeSize (l6,u6) * (+                index (l5,u5) i5 + rangeSize (l5,u5) * (+                 index (l4,u4) i4 + rangeSize (l4,u4) * (+                  index (l3,u3) i3 + rangeSize (l3,u3) * (+                   index (l2,u2) i2 + rangeSize (l2,u2) * (+                    index (l1,u1) i1)))))))))))))++    inRange ((l1,l2,l3,l4,l5,l6,l7,l8,l9,l10,l11,l12,l13,l14)+	    ,(u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14))+            (i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12,i13,i14) =+         inRange (l1,u1) i1+           && inRange (l2,u2) i2+           && inRange (l3,u3) i3+           && inRange (l4,u4) i4+           && inRange (l5,u5) i5+           && inRange (l6,u6) i6+           && inRange (l7,u7) i7+           && inRange (l8,u8) i8+           && inRange (l9,u9) i9+           && inRange (l10,u10) i10+           && inRange (l11,u11) i11+           && inRange (l12,u12) i12+           && inRange (l13,u13) i13+           && inRange (l14,u14) i14++instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5, Ix a6, Ix a7, Ix a8, Ix a9+	 ,Ix a10, Ix a11, Ix a12, Ix a13, Ix a14, Ix a15) =>+	 Ix (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15)  where+    range ((l1,l2,l3,l4,l5,l6,l7,l8,l9,l10,l11,l12,l13,l14,l15)+	  ,(u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14,u15)) =+          [(i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12,i13,i14,i15)+			 | i1 <- range (l1,u1),+                           i2 <- range (l2,u2),+                           i3 <- range (l3,u3),+                           i4 <- range (l4,u4),+                           i5 <- range (l5,u5),+                           i6 <- range (l6,u6),+                           i7 <- range (l7,u7),+                           i8 <- range (l8,u8),+                           i9 <- range (l9,u9),+                           i10 <- range (l10,u10),+                           i11 <- range (l11,u11),+                           i12 <- range (l12,u12),+                           i13 <- range (l13,u13),+                           i14 <- range (l14,u14),+                           i15 <- range (l15,u15)]++    index ((l1,l2,l3,l4,l5,l6,l7,l8,l9,l10,l11,l12,l13,l14,l15)+	  ,(u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14,u15))+          (i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12,i13,i14,i15) =+      index (l15,u15) i15 + rangeSize (l15,u15) * (+       index (l14,u14) i14 + rangeSize (l14,u14) * (+        index (l13,u13) i13 + rangeSize (l13,u13) * (+         index (l12,u12) i12 + rangeSize (l12,u12) * (+          index (l11,u11) i11 + rangeSize (l11,u11) * (+           index (l10,u10) i10 + rangeSize (l10,u10) * (+            index (l9,u9) i9 + rangeSize (l9,u9) * (+             index (l8,u8) i8 + rangeSize (l8,u8) * (+              index (l7,u7) i7 + rangeSize (l7,u7) * (+               index (l6,u6) i6 + rangeSize (l6,u6) * (+                index (l5,u5) i5 + rangeSize (l5,u5) * (+                 index (l4,u4) i4 + rangeSize (l4,u4) * (+                  index (l3,u3) i3 + rangeSize (l3,u3) * (+                   index (l2,u2) i2 + rangeSize (l2,u2) * (+                    index (l1,u1) i1))))))))))))))++    inRange ((l1,l2,l3,l4,l5,l6,l7,l8,l9,l10,l11,l12,l13,l14,l15)+	    ,(u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14,u15))+            (i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12,i13,i14,i15) =+         inRange (l1,u1) i1+           && inRange (l2,u2) i2+           && inRange (l3,u3) i3+           && inRange (l4,u4) i4+           && inRange (l5,u5) i5+           && inRange (l6,u6) i6+           && inRange (l7,u7) i7+           && inRange (l8,u8) i8+           && inRange (l9,u9) i9+           && inRange (l10,u10) i10+           && inRange (l11,u11) i11+           && inRange (l12,u12) i12+           && inRange (l13,u13) i13+           && inRange (l14,u14) i14+           && inRange (l15,u15) i15+++
+ libraries/List.hs view
@@ -0,0 +1,295 @@+module List ( +    elemIndex, elemIndices,+    find, findIndex, findIndices,+    nub, nubBy, delete, deleteBy, (\\), deleteFirstsBy,+    union, unionBy, intersect, intersectBy,+    intersperse, transpose, partition, group, groupBy,+    inits, tails, isPrefixOf, isSuffixOf,+    mapAccumL, mapAccumR,+    sort, sortBy, insert, insertBy, maximumBy, minimumBy,+    genericLength, genericTake, genericDrop,+    genericSplitAt, genericIndex, genericReplicate,+    zip4, zip5, zip6, zip7,+    zipWith4, zipWith5, zipWith6, zipWith7,+    unzip4, unzip5, unzip6, unzip7, unfoldr,++    -- ...and what the Prelude exports+    -- []((:), []), -- This is built-in syntax+    map, (++), concat, filter,+    head, last, tail, init, null, length, (!!),+    foldl, foldl1, scanl, scanl1, foldr, foldr1, scanr, scanr1,+    iterate, repeat, replicate, cycle,+    take, drop, splitAt, takeWhile, dropWhile, span, break,+    lines, words, unlines, unwords, reverse, and, or,+    any, all, elem, notElem, lookup,+    sum, product, maximum, minimum, concatMap, +    zip, zip3, zipWith, zipWith3, unzip, unzip3+    ) where++import Maybe( listToMaybe )++infix 5 \\++elemIndex               :: Eq a => a -> [a] -> Maybe Int+elemIndex x             =  findIndex (x ==)+        +elemIndices             :: Eq a => a -> [a] -> [Int]+elemIndices x           =  findIndices (x ==)+                        +find                    :: (a -> Bool) -> [a] -> Maybe a+find p                  =  listToMaybe . filter p++findIndex               :: (a -> Bool) -> [a] -> Maybe Int+findIndex p             =  listToMaybe . findIndices p++findIndices             :: (a -> Bool) -> [a] -> [Int]+findIndices p xs        =  [ i | (x,i) <- zip xs [0..], p x ]++nub                     :: Eq a => [a] -> [a]+nub                     =  nubBy (==)++nubBy                   :: (a -> a -> Bool) -> [a] -> [a]+nubBy eq []             =  []+nubBy eq (x:xs)         =  x : nubBy eq (filter (\y -> not (eq x y)) xs)++delete                  :: Eq a => a -> [a] -> [a]+delete                  =  deleteBy (==)++deleteBy                :: (a -> a -> Bool) -> a -> [a] -> [a]+deleteBy eq x []        = []+deleteBy eq x (y:ys)    = if x `eq` y then ys else y : deleteBy eq x ys++(\\)                    :: Eq a => [a] -> [a] -> [a]+(\\)                    =  foldl (flip delete)++deleteFirstsBy          :: (a -> a -> Bool) -> [a] -> [a] -> [a]+deleteFirstsBy eq       =  foldl (flip (deleteBy eq))++union                   :: Eq a => [a] -> [a] -> [a]+union                   =  unionBy (==)    ++unionBy                 :: (a -> a -> Bool) -> [a] -> [a] -> [a]+unionBy eq xs ys        =  xs ++ deleteFirstsBy eq (nubBy eq ys) xs++intersect               :: Eq a => [a] -> [a] -> [a]+intersect               =  intersectBy (==)++intersectBy             :: (a -> a -> Bool) -> [a] -> [a] -> [a]+intersectBy eq xs ys    =  [x | x <- xs, any (eq x) ys]++intersperse             :: a -> [a] -> [a]+intersperse sep []      =  []+intersperse sep [x]     =  [x]+intersperse sep (x:xs)  =  x : sep : intersperse sep xs++-- transpose is lazy in both rows and columns,+--       and works for non-rectangular 'matrices'+-- For example, transpose [[1,2],[3,4,5],[]]  =  [[1,3],[2,4],[5]]+-- Note that [h | (h:t) <- xss] is not the same as (map head xss)+--      because the former discards empty sublists inside xss+transpose                :: [[a]] -> [[a]]+transpose []             = []+transpose ([]     : xss) = transpose xss+transpose ((x:xs) : xss) = (x : [h | (h:t) <- xss]) : +                           transpose (xs : [t | (h:t) <- xss])++partition               :: (a -> Bool) -> [a] -> ([a],[a])+partition p xs          =  (filter p xs, filter (not . p) xs)++-- group splits its list argument into a list of lists of equal, adjacent+-- elements.  e.g.,+-- group "Mississippi" == ["M","i","ss","i","ss","i","pp","i"]+group                   :: Eq a => [a] -> [[a]]+group                   =  groupBy (==)++groupBy                 :: (a -> a -> Bool) -> [a] -> [[a]]+groupBy eq []           =  []+groupBy eq (x:xs)       =  (x:ys) : groupBy eq zs+                           where (ys,zs) = span (eq x) xs++-- inits xs returns the list of initial segments of xs, shortest first.+-- e.g., inits "abc" == ["","a","ab","abc"]+inits                   :: [a] -> [[a]]+inits []                =  [[]]+inits (x:xs)            =  [[]] ++ map (x:) (inits xs)++-- tails xs returns the list of all final segments of xs, longest first.+-- e.g., tails "abc" == ["abc", "bc", "c",""]+tails                   :: [a] -> [[a]]+tails []                =  [[]]+tails xxs@(_:xs)        =  xxs : tails xs++isPrefixOf               :: Eq a => [a] -> [a] -> Bool+isPrefixOf []     _      =  True+isPrefixOf _      []     =  False+isPrefixOf (x:xs) (y:ys) =  x == y && isPrefixOf xs ys++isSuffixOf              :: Eq a => [a] -> [a] -> Bool+isSuffixOf x y          =  reverse x `isPrefixOf` reverse y++mapAccumL               :: (a -> b -> (a, c)) -> a -> [b] -> (a, [c])+mapAccumL f s []        =  (s, [])+mapAccumL f s (x:xs)    =  (s'',y:ys)+                           where (s', y ) = f s x+                                 (s'',ys) = mapAccumL f s' xs++mapAccumR               :: (a -> b -> (a, c)) -> a -> [b] -> (a, [c])+mapAccumR f s []        =  (s, [])+mapAccumR f s (x:xs)    =  (s'', y:ys)+                           where (s'',y ) = f s' x+                                 (s', ys) = mapAccumR f s xs++unfoldr                 :: (b -> Maybe (a,b)) -> b -> [a]+unfoldr f b             = case f b of+                                Nothing    -> []+                                Just (a,b) -> a : unfoldr f b++sort                    :: (Ord a) => [a] -> [a]+sort                    =  sortBy compare++sortBy                  :: (a -> a -> Ordering) -> [a] -> [a]+sortBy cmp = mergeAll . sequences+  where+    sequences (a:b:xs)+      | a `cmp` b == GT = descending b [a]  xs+      | otherwise       = ascending  b (a:) xs+    sequences xs = [xs]++    descending a as (b:bs)+      | a `cmp` b == GT = descending b (a:as) bs+    descending a as bs  = (a:as): sequences bs++    ascending a as (b:bs)+      | a `cmp` b /= GT = ascending b (\ys -> as (a:ys)) bs+    ascending a as bs   = as [a]: sequences bs++    mergeAll [x] = x+    mergeAll xs  = mergeAll (mergePairs xs)++    mergePairs (a:b:xs) = merge a b: mergePairs xs+    mergePairs xs       = xs++    merge as@(a:as') bs@(b:bs')+      | a `cmp` b == GT = b:merge as  bs'+      | otherwise       = a:merge as' bs+    merge [] bs         = bs+    merge as []         = as++insert                  :: (Ord a) => a -> [a] -> [a]+insert                  = insertBy compare++insertBy                :: (a -> a -> Ordering) -> a -> [a] -> [a]+insertBy cmp x []       =  [x]+insertBy cmp x ys@(y:ys')+                        =  case cmp x y of+                                GT -> y : insertBy cmp x ys'+                                _  -> x : ys++maximumBy               :: (a -> a -> Ordering) -> [a] -> a+maximumBy cmp []        =  error "List.maximumBy: empty list"+maximumBy cmp xs        =  foldl1 max xs+                        where+                           max x y = case cmp x y of+                                        GT -> x+                                        _  -> y++minimumBy               :: (a -> a -> Ordering) -> [a] -> a+minimumBy cmp []        =  error "List.minimumBy: empty list"+minimumBy cmp xs        =  foldl1 min xs+                        where+                           min x y = case cmp x y of+                                        GT -> y+                                        _  -> x++genericLength           :: (Integral a) => [b] -> a+genericLength []        =  0+genericLength (x:xs)    =  1 + genericLength xs++genericTake             :: (Integral a) => a -> [b] -> [b]+genericTake _ []        =  []+genericTake 0 _         =  []+genericTake n (x:xs) +   | n > 0              =  x : genericTake (n-1) xs+   | otherwise          =  error "List.genericTake: negative argument"++genericDrop             :: (Integral a) => a -> [b] -> [b]+genericDrop 0 xs        =  xs+genericDrop _ []        =  []+genericDrop n (_:xs) +   | n > 0              =  genericDrop (n-1) xs+   | otherwise          =  error "List.genericDrop: negative argument"++genericSplitAt          :: (Integral a) => a -> [b] -> ([b],[b])+genericSplitAt 0 xs     =  ([],xs)+genericSplitAt _ []     =  ([],[])+genericSplitAt n (x:xs) +   | n > 0              =  (x:xs',xs'')+   | otherwise          =  error "List.genericSplitAt: negative argument"+       where (xs',xs'') =  genericSplitAt (n-1) xs++genericIndex            :: (Integral a) => [b] -> a -> b+genericIndex (x:_)  0   =  x+genericIndex (_:xs) n +        | n > 0         =  genericIndex xs (n-1)+        | otherwise     =  error "List.genericIndex: negative argument"+genericIndex _ _        =  error "List.genericIndex: index too large"++genericReplicate        :: (Integral a) => a -> b -> [b]+genericReplicate n x    =  genericTake n (repeat x)+ +zip4                    :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]+zip4                    =  zipWith4 (,,,)++zip5                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]+zip5                    =  zipWith5 (,,,,)++zip6                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> +                              [(a,b,c,d,e,f)]+zip6                    =  zipWith6 (,,,,,)++zip7                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->+                              [g] -> [(a,b,c,d,e,f,g)]+zip7                    =  zipWith7 (,,,,,,)++zipWith4                :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]+zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)+                        =  z a b c d : zipWith4 z as bs cs ds+zipWith4 _ _ _ _ _      =  []++zipWith5                :: (a->b->c->d->e->f) -> +                           [a]->[b]->[c]->[d]->[e]->[f]+zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)+                        =  z a b c d e : zipWith5 z as bs cs ds es+zipWith5 _ _ _ _ _ _    =  []++zipWith6                :: (a->b->c->d->e->f->g) ->+                           [a]->[b]->[c]->[d]->[e]->[f]->[g]+zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)+                        =  z a b c d e f : zipWith6 z as bs cs ds es fs+zipWith6 _ _ _ _ _ _ _  =  []++zipWith7                :: (a->b->c->d->e->f->g->h) ->+                           [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]+zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)+                   =  z a b c d e f g : zipWith7 z as bs cs ds es fs gs+zipWith7 _ _ _ _ _ _ _ _ = []++unzip4                  :: [(a,b,c,d)] -> ([a],[b],[c],[d])+unzip4                  =  foldr (\(a,b,c,d) ~(as,bs,cs,ds) ->+                                        (a:as,b:bs,c:cs,d:ds))+                                 ([],[],[],[])++unzip5                  :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])+unzip5                  =  foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->+                                        (a:as,b:bs,c:cs,d:ds,e:es))+                                 ([],[],[],[],[])++unzip6                  :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])+unzip6                  =  foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->+                                        (a:as,b:bs,c:cs,d:ds,e:es,f:fs))+                                 ([],[],[],[],[],[])++unzip7          :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])+unzip7          =  foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) ->+                                (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))+                         ([],[],[],[],[],[],[])
+ libraries/Locale.hs view
@@ -0,0 +1,32 @@+module Locale(TimeLocale(TimeLocale,wDays,months,amPm,dateTimeFmt,dateFmt+                        ,timeFmt,time12Fmt)+             ,defaultTimeLocale) where++data TimeLocale = TimeLocale {+        wDays  :: [(String, String)],   -- full and abbreviated week days+        months :: [(String, String)],   -- full and abbreviated months+        amPm   :: (String, String),     -- AM/PM symbols+        dateTimeFmt, dateFmt,           -- formatting strings+          timeFmt, time12Fmt :: String     +        } deriving (Eq, Ord, Show)++defaultTimeLocale :: TimeLocale +defaultTimeLocale =  TimeLocale { +        wDays  = [("Sunday",   "Sun"),  ("Monday",    "Mon"),   +                  ("Tuesday",  "Tue"),  ("Wednesday", "Wed"), +                  ("Thursday", "Thu"),  ("Friday",    "Fri"), +                  ("Saturday", "Sat")],++        months = [("January",   "Jan"), ("February",  "Feb"),+                  ("March",     "Mar"), ("April",     "Apr"),+                  ("May",       "May"), ("June",      "Jun"),+                  ("July",      "Jul"), ("August",    "Aug"),+                  ("September", "Sep"), ("October",   "Oct"),+                  ("November",  "Nov"), ("December",  "Dec")],++        amPm = ("AM", "PM"),+        dateTimeFmt = "%a %b %e %H:%M:%S %Z %Y",+        dateFmt = "%m/%d/%y",+        timeFmt = "%H:%M:%S",+        time12Fmt = "%I:%M:%S %p"+        }
+ libraries/Maybe.hs view
@@ -0,0 +1,38 @@+module Maybe(+    isJust, isNothing,+    fromJust, fromMaybe, listToMaybe, maybeToList,+    catMaybes, mapMaybe,++    -- ...and what the Prelude exports+    Maybe(Nothing, Just),+    maybe+  ) where++isJust                 :: Maybe a -> Bool+isJust (Just a)        =  True+isJust Nothing         =  False++isNothing        :: Maybe a -> Bool+isNothing        =  not . isJust++fromJust               :: Maybe a -> a+fromJust (Just a)      =  a+fromJust Nothing       =  error "Maybe.fromJust: Nothing"++fromMaybe              :: a -> Maybe a -> a+fromMaybe d Nothing    =  d+fromMaybe d (Just a)   =  a++maybeToList            :: Maybe a -> [a]+maybeToList Nothing    =  []+maybeToList (Just a)   =  [a]++listToMaybe            :: [a] -> Maybe a+listToMaybe []         =  Nothing+listToMaybe (a:_)      =  Just a+ +catMaybes              :: [Maybe a] -> [a]+catMaybes ms           =  [ m | Just m <- ms ]++mapMaybe               :: (a -> Maybe b) -> [a] -> [b]+mapMaybe f             =  catMaybes . map f
+ libraries/Monad.hs view
@@ -0,0 +1,95 @@+module Monad (+    MonadPlus(mzero, mplus),+    join, guard, when, unless, ap,+    msum,+    filterM, mapAndUnzipM, zipWithM, zipWithM_, foldM, +    liftM, liftM2, liftM3, liftM4, liftM5,++    -- ...and what the Prelude exports+    Monad((>>=), (>>), return, fail),+    Functor(fmap),+    mapM, mapM_, sequence, sequence_, (=<<), +    ) where+++-- The MonadPlus class definition++class  (Monad m) => MonadPlus m  where+    mzero  :: m a+    mplus  :: m a -> m a -> m a+++-- Instances of MonadPlus++instance  MonadPlus Maybe  where+    mzero                 = Nothing++    Nothing `mplus` ys    =  ys+    xs      `mplus` ys    =  xs++instance  MonadPlus []  where+    mzero =  []+    mplus = (++)+++-- Functions    +++msum  :: MonadPlus m => [m a] -> m a+msum xs  =  foldr mplus mzero xs++join             :: (Monad m) => m (m a) -> m a+join x           =  x >>= id++when             :: (Monad m) => Bool -> m () -> m ()+when p s         =  if p then s else return ()++unless           :: (Monad m) => Bool -> m () -> m ()+unless p s       =  when (not p) s++ap               :: (Monad m) => m (a -> b) -> m a -> m b+ap               =  liftM2 ($)++guard            :: MonadPlus m => Bool -> m ()+guard p          =  if p then return () else mzero++mapAndUnzipM     :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c])+mapAndUnzipM f xs = sequence (map f xs) >>= return . unzip++zipWithM         :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]+zipWithM f xs ys =  sequence (zipWith f xs ys)++zipWithM_         :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m ()+zipWithM_ f xs ys =  sequence_ (zipWith f xs ys)++foldM            :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a+foldM f a []     =  return a+foldM f a (x:xs) =  f a x >>= \ y -> foldM f y xs++filterM :: Monad m => (a -> m Bool) -> [a] -> m [a]+filterM p []     = return []+filterM p (x:xs) = do { b  <- p x;+ys <- filterM p xs; +return (if b then (x:ys) else ys)+   }++liftM            :: (Monad m) => (a -> b) -> (m a -> m b)+liftM f          =  \a -> do { a' <- a; return (f a') }++liftM2           :: (Monad m) => (a -> b -> c) -> (m a -> m b -> m c)+liftM2 f         =  \a b -> do { a' <- a; b' <- b; return (f a' b') }++liftM3           :: (Monad m) => (a -> b -> c -> d) ->+                                 (m a -> m b -> m c -> m d)+liftM3 f         =  \a b c -> do { a' <- a; b' <- b; c' <- c;+   return (f a' b' c') }++liftM4           :: (Monad m) => (a -> b -> c -> d -> e) ->+                                 (m a -> m b -> m c -> m d -> m e)+liftM4 f         =  \a b c d -> do { a' <- a; b' <- b; c' <- c; d' <- d;+     return (f a' b' c' d') }++liftM5           :: (Monad m) => (a -> b -> c -> d -> e -> f) ->+                                 (m a -> m b -> m c -> m d -> m e -> m f)+liftM5 f         =  \a b c d e -> do { a' <- a; b' <- b; c' <- c; d' <- d;+       e' <- e; return (f a' b' c' d' e') }
+ libraries/Numeric.hs view
@@ -0,0 +1,13 @@+--  Wrapper that exports just the stuff normally defined in the +--  standard module Numeric. +module Numeric(fromRat,+               showSigned, showIntAtBase,+               showInt, showOct, showHex,+               readSigned, readInt,+               readDec, readOct, readHex, +               floatToDigits,+               showEFloat, showFFloat, showGFloat, showFloat, +               readFloat, lexDigits) where++import PreludeBasic+
+ libraries/Prelude.hs view
@@ -0,0 +1,84 @@+{-# hat-trans -cpp #-}+-- Wrapper that exports just the stuff normally defined in the +-- Prelude. +-- The export list was copied from the Haskell 98 report.+module Prelude (+    -- for internal purposes of desugared list comprehensions+    -- hopefully to disappear soon+    _filter,_foldr,+    -- module PreludeList:+    map, (++), filter, concat,+    head, last, tail, init, null, length, (!!), +    foldl, foldl1, scanl, scanl1, foldr, foldr1, scanr, scanr1,+    iterate, repeat, replicate, cycle,+    take, drop, splitAt, takeWhile, dropWhile, span, break,+    lines, words, unlines, unwords, reverse, and, or,+    any, all, elem, notElem, lookup,+    sum, product, maximum, minimum, concatMap, +    zip, zip3, zipWith, zipWith3, unzip, unzip3,+    -- module PreludeText:+    ReadS, ShowS,+    Read(readsPrec, readList),+    Show(showsPrec, show, showList),+    reads, shows, read, lex,+    showChar, showString, readParen, showParen, +    -- module PreludeIO:+    FilePath, IOError, ioError, userError, catch,+    putChar, putStr, putStrLn, print,+    getChar, getLine, getContents, interact,+    readFile, writeFile, appendFile, readIO, readLn,+    -- defined here:+    Bool(False, True),+    Maybe(Nothing, Just),+    Either(Left, Right),+    Ordering(LT, EQ, GT),+    Char, String, Int, Integer, Float, Double, Rational, IO,++--      These built-in types are defined in the Prelude, but+--      are denoted by built-in syntax, and cannot legally+--      appear in an export list.+--  But they do here, because the .hx interface needs the exports.+-- Commented out for Cabal-Hat+-- #ifdef HX+--  List type: +--    []((:), []),+--  Tuple types: up to 15+--    (,)((,)), (,,)((,,)),(,,,)((,,,)),(,,,,)((,,,,)),(,,,,,)((,,,,,)),+--    (,,,,,,)((,,,,,,)),(,,,,,,,)((,,,,,,,)),(,,,,,,,,)((,,,,,,,,)),+--    (,,,,,,,,,)((,,,,,,,,,)),(,,,,,,,,,,)((,,,,,,,,,,)),+--    (,,,,,,,,,,,)((,,,,,,,,,,,)),(,,,,,,,,,,,,)((,,,,,,,,,,,,)),+--    (,,,,,,,,,,,,,)((,,,,,,,,,,,,,)),(,,,,,,,,,,,,,,)((,,,,,,,,,,,,,,)),+--  Trivial type: +--    ()(()),+--  Functions: +--    (->),+-- #endif++    Eq((==), (/=)),+    Ord(compare, (<), (<=), (>=), (>), max, min),+    Enum(succ, pred, toEnum, fromEnum, enumFrom, enumFromThen,+         enumFromTo, enumFromThenTo),+    Bounded(minBound, maxBound),+    Num((+), (-), (*), negate, abs, signum, fromInteger),+    Real(toRational),+    Integral(quot, rem, div, mod, quotRem, divMod, toInteger),+    Fractional((/), recip, fromRational),+    Floating(pi, exp, log, sqrt, (**), logBase, sin, cos, tan,+             asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh),+    RealFrac(properFraction, truncate, round, ceiling, floor),+    RealFloat(floatRadix, floatDigits, floatRange, decodeFloat,+              encodeFloat, exponent, significand, scaleFloat, isNaN,+              isInfinite, isDenormalized, isIEEE, isNegativeZero, atan2),+    Monad((>>=), (>>), return, fail),+    Functor(fmap),+    mapM, mapM_, sequence, sequence_, (=<<), +    maybe, either,+    (&&), (||), not, otherwise,+    subtract, even, odd, gcd, lcm, (^), (^^), +    fromIntegral, realToFrac, +    fst, snd, curry, uncurry, id, const, (.), flip, ($), until,+    asTypeOf, error, undefined,+    seq, ($!)+  ) where++import PreludeBasic
+ libraries/PreludeBasic.hs view
@@ -0,0 +1,3276 @@+-- Contains all parts of the Prelude and Char (both are mutually+-- recursive) that can be expressed in Haskell (assuming +-- nhc98's ability to derive instances of [],(,,,) etc).+-- Hand-generated from Haskell +module PreludeBasic +  (module PreludeBasic, module PreludeBuiltin) +  where++-- import PreludeBuiltin  -- Contains all `prim' values+-- import PreludeList+-- import PreludeText+-- import PreludeIO+-- import Ratio( Rational )++import PreludeBuiltinTypes+import PreludeBuiltin++infixr 9  .+infixr 8  ^, ^^, **+infixl 7  *, /, `quot`, `rem`, `div`, `mod`+infixl 6  +, -++-- The (:) operator is built-in syntax, and cannot legally be given+-- a fixity declaration; but its fixity is given by:+--   infixr 5  :++infix  4  ==, /=, <, <=, >=, >+infixr 3  &&+infixr 2  ||+infixl 1  >>, >>=+infixr 1  =<<+infixr 0  $, $!  --, `seq`+++-- Internal functions used by the transformation in desugaring+-- and deriving of instances. +-- Not exported from Prelude itself.++yield :: a -> ReadS a+yield x r = [(x,r)]++lift :: (a -> b -> ReadS c) -> ReadS a -> ReadS b -> ReadS c              +lift c f g r = concatMap (\(x,s) -> concatMap (\(y,t) -> c x y t) (g s)) (f r)++thenAp :: ReadS (a -> b) -> ReadS a -> ReadS b+thenAp = lift (\h x t -> [(h x,t)])++thenLex :: ReadS a -> String -> ReadS a+thenLex f xs = lift (\x y t -> if y==xs then [(x,t)] else []) f lex++alt :: ReadS a -> ReadS a -> ReadS a+alt f g r = f r ++ g r+++-- Standard types, classes, instances and related functions++-- Equality and Ordered classes+class  Eq a  where+    (==), (/=)       :: a -> a -> Bool++        -- Minimal complete definition:+        --      (==) or (/=)+    x /= y           =  not (x == y)+    x == y           =  not (x /= y)+++class  (Eq a) => Ord a  where+    compare              :: a -> a -> Ordering+    (<), (<=), (>=), (>) :: a -> a -> Bool+    max, min             :: a -> a -> a++        -- Minimal complete definition:+        --      (<=) or compare+        -- Using compare can be more efficient for complex types.+    compare x y+         | x == y    =  EQ+         | x <= y    =  LT+         | otherwise =  GT++    x <= y           =  compare x y /= GT+    x <  y           =  compare x y == LT+    x >= y           =  compare x y /= LT+    x >  y           =  compare x y == GT++-- note that (min x y, max x y) = (x,y) or (y,x)+    max x y +         | x <= y    =  y+         | otherwise =  x+    min x y+         | x <= y    =  x+         | otherwise =  y++-- Enumeration and Bounded classes+++class  Enum a  where+    succ, pred       :: a -> a+    toEnum           :: Int -> a+    fromEnum         :: a -> Int+    enumFrom         :: a -> [a]             -- [n..]+    enumFromThen     :: a -> a -> [a]        -- [n,n'..]+    enumFromTo       :: a -> a -> [a]        -- [n..m]+    enumFromThenTo   :: a -> a -> a -> [a]   -- [n,n'..m]++        -- Minimal complete definition:+        --      toEnum, fromEnum+--+-- NOTE: these default methods only make sense for types+--   that map injectively into Int using fromEnum+--  and toEnum.+    succ             =  toEnum . (+1) . fromEnum+    pred             =  toEnum . (subtract 1) . fromEnum+    enumFrom x       =  map toEnum [fromEnum x ..]+    enumFromTo x y   =  map toEnum [fromEnum x .. fromEnum y]+    enumFromThen x y =  map toEnum [fromEnum x, fromEnum y ..]+    enumFromThenTo x y z = +                        map toEnum [fromEnum x, fromEnum y .. fromEnum z]+++class  Bounded a  where+    minBound         :: a+    maxBound         :: a++-- Numeric classes+++class  (Eq a, Show a) => Num a  where+    (+), (-), (*)    :: a -> a -> a+    negate           :: a -> a+    abs, signum      :: a -> a+    fromInteger      :: Integer -> a++        -- Minimal complete definition:+        --      All, except negate or (-)+    x - y            =  x + negate y+    negate x         =  0 - x+++class  (Num a, Ord a) => Real a  where+    toRational       ::  a -> Rational+++class  (Real a, Enum a) => Integral a  where+    quot, rem        :: a -> a -> a   +    div, mod         :: a -> a -> a+    quotRem, divMod  :: a -> a -> (a,a)+    toInteger        :: a -> Integer++        -- Minimal complete definition:+        --      quotRem, toInteger+    n `quot` d       =  q  where (q,r) = quotRem n d+    n `rem` d        =  r  where (q,r) = quotRem n d+    n `div` d        =  q  where (q,r) = divMod n d+    n `mod` d        =  r  where (q,r) = divMod n d+    divMod n d       =  if signum r == negate (signum d) then (q-1, r+d) else qr+                        -- replaced prefix - by negate+                        -- to make AuxFixity of nhc98 happy+                        where qr@(q,r) = quotRem n d+++class  (Num a) => Fractional a  where+    (/)              :: a -> a -> a+    recip            :: a -> a+    fromRational     :: Rational -> a++        -- Minimal complete definition:+        --      fromRational and (recip or (/))+    recip x          =  1 / x+    x / y            =  x * recip y+++class  (Fractional a) => Floating a  where+    pi                  :: a+    exp, log, sqrt      :: a -> a+    (**), logBase       :: a -> a -> a+    sin, cos, tan       :: a -> a+    asin, acos, atan    :: a -> a+    sinh, cosh, tanh    :: a -> a+    asinh, acosh, atanh :: a -> a++        -- Minimal complete definition:+        --      pi, exp, log, sin, cos, sinh, cosh+        --      asin, acos, atan+        --      asinh, acosh, atanh+    x ** y           =  exp (log x * y)+    logBase x y      =  log y / log x+    sqrt x           =  x ** 0.5+    tan  x           =  sin  x / cos  x+    tanh x           =  sinh x / cosh x++++class  (Real a, Fractional a) => RealFrac a  where+    properFraction   :: (Integral b) => a -> (b,a)+    truncate, round  :: (Integral b) => a -> b+    ceiling, floor   :: (Integral b) => a -> b++        -- Minimal complete definition:+        --      properFraction+    truncate x       =  m  where (m,_) = properFraction x+    +    round x          =  let (n,r) = properFraction x+                            m     = if r < 0 then n - 1 else n + 1+                          in case signum (abs r - 0.5) `compare` 0 of+                                LT -> n+                                EQ  -> if even n then n else m+                                GT  -> m+-- original version+-- nhc doesn't like prefix - when prelude is not imported unqualified+--                          in case signum (abs r - 0.5) of+--                                -1 -> n+--                                0  -> if even n then n else m+--                                1  -> m+    +    ceiling x        =  if r > 0 then n + 1 else n+                        where (n,r) = properFraction x+    +    floor x          =  if r < 0 then n - 1 else n+                        where (n,r) = properFraction x+++class  (RealFrac a, Floating a) => RealFloat a  where+    floatRadix       :: a -> Integer+    floatDigits      :: a -> Int+    floatRange       :: a -> (Int,Int)+    decodeFloat      :: a -> (Integer,Int)+    encodeFloat      :: Integer -> Int -> a+    exponent         :: a -> Int+    significand      :: a -> a+    scaleFloat       :: Int -> a -> a+    isNaN, isInfinite, isDenormalized, isNegativeZero, isIEEE+                     :: a -> Bool+    atan2            :: a -> a -> a++        -- Minimal complete definition:+        --      All except exponent, significand, +        --                 scaleFloat, atan2+    exponent x       =  if m == 0 then 0 else n + floatDigits x+                        where (m,n) = decodeFloat x++    significand x    =  encodeFloat m (- floatDigits x)+                        where (m,_) = decodeFloat x++    scaleFloat k x   =  encodeFloat m (n+k)+                        where (m,n) = decodeFloat x++    atan2 y x+      | x>0           =  atan (y/x)+      | x==0 && y>0   =  pi/2+      | x<0  && y>0   =  pi + atan (y/x) +      |(x<=0 && y<0)  ||+       (x<0 && isNegativeZero y) ||+       (isNegativeZero x && isNegativeZero y)+                      = -atan2 (-y) x+      | y==0 && (x<0 || isNegativeZero x)+                      =  pi    -- must be after the previous test on zero y+      | x==0 && y==0  =  y     -- must be after the other double zero tests+      | otherwise     =  x + y -- x or y is a NaN, return a NaN (via +)++-- Numeric functions+++subtract         :: (Num a) => a -> a -> a+subtract         =  flip (-)+++even, odd        :: (Integral a) => a -> Bool+even n           =  n `rem` 2 == 0+odd              =  not . even+++gcd              :: (Integral a) => a -> a -> a+gcd 0 0          =  error "Prelude.gcd: gcd 0 0 is undefined"+gcd x y          =  gcd' (abs x) (abs y)+                    where gcd' x 0  =  x+                          gcd' x y  =  gcd' y (x `rem` y)+++lcm              :: (Integral a) => a -> a -> a+lcm _ 0          =  0+lcm 0 _          =  0+lcm x y          =  abs ((x `quot` (gcd x y)) * y)+++(^)              :: (Num a, Integral b) => a -> b -> a+x ^ 0            =  1+x ^ n | n > 0    =  f x (n-1) x+                    where f _ 0 y = y+                          f x n y = g x n  where+                                    g x n | even n  = g (x*x) (n `quot` 2)+                                          | otherwise = f x (n-1) (x*y)+_ ^ _            = error "Prelude.^: negative exponent"+++(^^)             :: (Fractional a, Integral b) => a -> b -> a+x ^^ n           =  if n >= 0 then x^n else recip (x^(-n))+++fromIntegral     :: (Integral a, Num b) => a -> b+fromIntegral     =  fromInteger . toInteger+++realToFrac     :: (Real a, Fractional b) => a -> b+realToFrac      =  fromRational . toRational++-- Monadic classes+++class  Functor f  where+    fmap              :: (a -> b) -> f a -> f b+++class  Monad m  where+    (>>=)  :: m a -> (a -> m b) -> m b+    (>>)   :: m a -> m b -> m b+    return :: a -> m a+    fail   :: String -> m a++        -- Minimal complete definition:+        --      (>>=), return+    m >> k  =  m >>= \_ -> k+    fail s  = error s+++sequence       :: Monad m => [m a] -> m [a] +sequence       =  foldr mcons (return [])+                    where mcons p q = p >>= \x -> q >>= \y -> return (x:y)+++sequence_      :: Monad m => [m a] -> m () +sequence_      =  foldr (>>) (return ())++-- The xxxM functions take list arguments, but lift the function or+-- list element to a monad type++mapM             :: Monad m => (a -> m b) -> [a] -> m [b]+mapM f as        =  sequence (map f as)+++mapM_            :: Monad m => (a -> m b) -> [a] -> m ()+mapM_ f as       =  sequence_ (map f as)+++(=<<)            :: Monad m => (a -> m b) -> m a -> m b+f =<< x          =  x >>= f+++-- Trivial type+++-- data  ()  =  ()  deriving (Eq, Ord, Enum, Bounded)++instance Eq () where+  () == () = True++instance Ord () where+  compare () () = EQ++instance Enum () where+  fromEnum () = 0+  toEnum   n | n==0  = ()+  toEnum   n         = error ("Prelude.Enum_Prelude.Unit_toEnum on " ++ show n)++instance Bounded () where+  minBound = ()+  maxBound = ()++-- Function type+++-- data a -> b  -- No constructor for functions is exported.++-- identity function++id               :: a -> a+id x             =  x++-- constant function++const            :: a -> b -> a+const x _        =  x++-- function composition++(.)              :: (b -> c) -> (a -> b) -> a -> c+(.) f g x        =  f (g x)++-- flip f  takes its (first) two arguments in the reverse order of f.++flip             :: (a -> b -> c) -> b -> a -> c+flip f x y       =  f y x+++-- seq :: a -> b -> b+-- seq = ...       -- Primitive++-- right-associating infix application operators +-- (useful in continuation-passing style)++($), ($!) :: (a -> b) -> a -> b+f $  x    =  f x+f $! x    =  x `seq` f x+++-- Boolean type+++-- data  Bool  =  False | True  deriving (Eq, Ord, Enum, Read, Show, Bounded)++instance Eq Bool where+  True  == True  = True+  False == False = True+  _     == _     = False++instance Ord Bool where+  compare False False = EQ+  compare False True  = LT+  compare True  False = GT+  compare True  True  = EQ++instance Enum Bool where+  fromEnum   False = 0+  fromEnum   True  = 1++  toEnum   0 = False+  toEnum   1 = True+  toEnum   n = error ("(Prelude.toEnum "++show n++" :: Bool) is wrong")++  enumFrom b = enumFromTo b True+  enumFromThen b1 b2 = enumFromThenTo b1 b2 (b2 >= b1)++instance Read Bool where+  readsPrec p = readParen False +		 ( \r -> [(False,s) | ("False",s) <- lex r] +++			 [(True,s)  | ("True",s) <- lex r])++instance Show Bool where+  showsPrec p False = showString "False"+  showsPrec p True = showString "True"++instance Bounded Bool where+  minBound = False+  maxBound = True+++-- Boolean functions+++(&&), (||)       :: Bool -> Bool -> Bool+True  && x       =  x+False && _       =  False+True  || _       =  True+False || x       =  x+                                        ++not              :: Bool -> Bool+not True         =  False+not False        =  True+++otherwise        :: Bool+otherwise        =  True+++-- Character type+++-- data Char = ... 'a' | 'b' ... -- 2^16 unicode values+++instance  Eq Char  where+    c == c'          =  fromEnum c == fromEnum c'+++instance  Ord Char  where+    c <= c'          =  fromEnum c <= fromEnum c'+++instance  Enum Char  where+    toEnum            = primIntToChar+    fromEnum          = primCharToInt+    enumFrom c        = map toEnum [fromEnum c .. fromEnum (maxBound::Char)]+    enumFromThen c c' = map toEnum [fromEnum c, fromEnum c' .. fromEnum lastChar]+                      where lastChar :: Char+                            lastChar | c' < c    = minBound+                                     | otherwise = maxBound+++instance  Bounded Char  where+    minBound            =  '\0'+    maxBound            =  primUnicodeMaxBound+++-- type  String = [Char]+++-- Maybe type+++data  Maybe a  =  Nothing | Just a      deriving (Eq, Ord, Read, Show)+++maybe              :: b -> (a -> b) -> Maybe a -> b+maybe n f Nothing  =  n+maybe n f (Just x) =  f x+++instance  Functor Maybe  where+    fmap f Nothing    =  Nothing+    fmap f (Just x)   =  Just (f x)+        ++instance  Monad Maybe  where+    (Just x) >>= k   =  k x+    Nothing  >>= k   =  Nothing+    return           =  Just+    fail s           =  Nothing++-- Either type+++data  Either a b  =  Left a | Right b   deriving (Eq, Ord, Read, Show)+++either               :: (a -> c) -> (b -> c) -> Either a b -> c+either f g (Left x)  =  f x+either f g (Right y) =  g y++-- IO type+++-- data  IO a  -- abstract+++instance  Functor IO where+   fmap f x           =  x >>= (return . f)+++instance Monad IO where+   (>>=)  = primIOBind+   return = primIOReturn+   fail s = ioError (userError s)++-- Ordering type+++data  Ordering  =  LT | EQ | GT+          deriving (Eq, Ord, Enum, Read, Show, Bounded)+++-- Standard numeric types.  The data declarations for these types cannot+-- be expressed directly in Haskell since the constructor lists would be+-- far too large.+++-- data  Int  =  minBound ... -1 | 0 | 1 ... maxBound++instance Eq Int where+  a == b = primIntEq a b+  a /= b = primIntNe a b++instance Ord Int where+  a <  b = primIntLt a b+  a <= b = primIntLe a b+  a >= b = primIntGe a b+  a >  b = primIntGt a b++instance Num Int where+ a + b    = primIntPlus a b+ a - b    = primIntMinus a b+ a * b    = primIntTimes a b+ negate a = primIntNegate a+ abs    a = primIntAbs a+ signum a = primIntSignum a+ fromInteger i = primIntFromInteger i++instance Real Int where+    toRational i = (toInteger i) % 1++instance Integral Int  where+    n `quot`    d   	= primIntQuot n d+    n `rem`     d   	= primIntRem n d+    n `quotRem` d 	= (n `quot` d, n `rem` d)++    toInteger n 	= primIntegerFromInt n++instance Enum Int where+  toEnum = id+  fromEnum = id++  enumFrom x = enumFromTo x maxBound+  enumFromThen x y = enumFromThenTo x y (if y >= x then maxBound else minBound)+  enumFromTo n m = intEnumFromByTo n 1 m+  enumFromThenTo n n' m = intEnumFromByTo n (n'-n) m++-- need to avoid evaluating number beyond m, +-- because m can be maxBound or minBound+intEnumFromByTo :: Int -> Int -> Int -> [Int]+intEnumFromByTo n d m =+  case d `compare` 0 of+    GT -> if n > m then [] else go (<= m-d) n +    EQ -> repeat n+    LT -> if n < m then [] else go (>= m-d) n+  where+  go :: (Int -> Bool) -> Int -> [Int]+  go continue n = n : if (continue n) then go continue (n+d) else [] +     ++instance Bounded Int where+  minBound = primIntMinBound+  maxBound = primIntMaxBound+++-- data  Integer  =  ... -1 | 0 | 1 ...++instance Eq Integer where+  a == b = primIntegerEq a b +  a /= b = primIntegerNe a b ++instance Ord Integer where+  a <  b = primIntegerLt a b +  a <= b = primIntegerLe a b+  a >= b = primIntegerGe a b +  a >  b = primIntegerGt a b ++instance Num Integer where+ a + b    = primIntegerAdd a b + a - b    = primIntegerSub a b + a * b    = primIntegerMul a b + negate a = primIntegerNeg a+ abs i    = if i < 0 then negate i else i+ signum i = case compare i 0 of+		LT -> negate 1+		EQ ->  0+		GT ->  1+ fromInteger a = a -- id a++instance Real Integer where+    toRational i = i % 1++instance Integral Integer  where+    n `quot` d 	  = primIntegerQuot n d+    n `rem`  d    = primIntegerRem n d+    n `div`  d    = fst (divMod n d) +    n `mod`  d 	  = snd (divMod n d) ++    n `quotRem` d = primIntegerQuotRem n d++    toInteger n   = n ++instance Enum Integer where+  succ x     = x+1+  pred x     = x-1+  toEnum x   = toInteger x+  fromEnum x = fromInteger x++  enumFrom = iterate (+1)+  enumFromThen n n' = iterate (+(n'-n)) n+  enumFromTo n m = takeWhile (<= m) (iterate (+1) n)+  enumFromThenTo n n' m = +    let d = n'-n in +      (if d >= 0 then takeWhile (<= m) (iterate (+d) n) +                 else takeWhile (>= m) (iterate (+d) n) )+++-- data  Float++instance Eq Float where+  a == b = primFloatEq a b+  a /= b = primFloatNe a b++instance Ord Float where+  a <  b = primFloatLt a b+  a <= b = primFloatLe a b+  a >= b = primFloatGe a b+  a >  b = primFloatGt a b++instance Num Float where+ a + b    = primFloatAdd a b+ a - b    = primFloatSub a b+ a * b    = primFloatMul a b+ negate a = 0 - a+ abs    a = primFloatAbs a+ signum a = primFloatSignum a+ fromInteger i = primFloatFromInteger i++instance Real Float where+    toRational x = case decodeFloat x of (m,n) -> (m%1)*(bf%1)^^n+			where bf     = floatRadix  x++instance Fractional Float where+  x / y = primFloatDiv x y+  fromRational x = x0+      where x0    = ff ef+            ff ef = if ef' == ef then yf else ff ef'+                   where yf :: Float+                         yf      = encodeFloat (round (x * (1 % bf) ^^ ef)) ef+                         (_,ef') = decodeFloat yf+                         bf      = floatRadix x0+            (_,ef) = decodeFloat (fromInteger (numerator x) `asTypeOf` x0+        	                                / fromInteger (denominator x))++instance  Floating Float where+    pi			=  primFloatPi+    exp	x		=  primFloatExp x+    log	x		=  primFloatLog x+    sqrt x		=  primFloatSqrt x+    sin	x		=  primFloatSin x+    cos	x		=  primFloatCos x+    tan	x		=  primFloatTan x+    asin x		=  primFloatAsin x+    acos x		=  primFloatAcos x+    atan x		=  primFloatAtan x+    sinh x              = 0.5  * (exp x - exp (-x))+    cosh x              = 0.5  * (exp x + exp (-x))+    tanh x              = (af-bf)/(af+bf) where af = exp x ; bf = exp (-x)+    asinh x = log (x + sqrt (1+x*x))+    acosh x = log (x + (x+1) * sqrt ((x-1)/(x+1)))+    atanh x = log ((x+1) / sqrt (1 - x*x))++instance  RealFrac Float where+    properFraction x =+        case decodeFloat x of+	  (m,n) -> if n >= 0 then+			(fromInteger m * fromInteger (floatRadix x) ^ n, 0)+		    else+			case quotRem m ((floatRadix x)^(negate n)) of+		          (w,r) -> (fromInteger w, encodeFloat r n)++instance  RealFloat Float  where+    floatRadix    = primFloatRadix+    floatDigits   = primFloatDigits+    floatRange    = primFloatRange+    decodeFloat x = primDecodeFloat x+    encodeFloat x y = primEncodeFloat x y++    isNaN 	   = primFloatIsNaN+    isInfinite     = primFloatIsInfinite+    isDenormalized = primFloatIsDenormalized+    isNegativeZero = primFloatIsNegativeZero+    isIEEE         = primFloatIsIEEE+++-- data  Double++instance Eq Double where+  a == b = primDoubleEq a b+  a /= b = primDoubleNe a b++instance Ord Double where+  a <  b = primDoubleLt a b+  a <= b = primDoubleLe a b+  a >= b = primDoubleGe a b+  a >  b = primDoubleGt a b++instance Num Double where+ a + b    = primDoubleAdd a b+ a - b    = primDoubleSub a b+ a * b    = primDoubleMul a b+ negate a = (0 - a)+ abs    a = primDoubleAbs a+ signum a = primDoubleSignum a+ fromInteger i = primDoubleFromInteger i++instance  Real Double where+    toRational x = case decodeFloat x of (m,n) -> (m%1)*(b%1)^^n+			where b     = floatRadix  x++instance  Fractional Double  where+  x / y = primDoubleDiv x y+  fromRational x =+      let f ex = let y :: Double+                     y  = encodeFloat (round (x * (1 % bd) ^^ ex)) ex+                     e' = snd (decodeFloat y)+                     bd = floatRadix x'+                 in if e' == ex then y else f e'+          e    = snd (decodeFloat (fromInteger (numerator x) `asTypeOf` x'+        	                                / fromInteger (denominator x)))+          x'   = f e+      in x'+++instance  Floating Double where+    pi                  =  primDoublePi+    exp x               =  primDoubleExp x+    log x               =  primDoubleLog x+    sqrt x              =  primDoubleSqrt x+    sin x               =  primDoubleSin x+    cos x               =  primDoubleCos x+    tan x               =  primDoubleTan x+    asin x              =  primDoubleAsin x+    acos x              =  primDoubleAcos x+    atan x              =  primDoubleAtan x+    sinh x              = fromRational (1%2) * (exp x - exp (-x))+    cosh x              = fromRational (1%2) * (exp x + exp (-x))+    tanh x              = (a-b)/(a+b) where a = exp x ; b = exp (-x)+    asinh x = log (x + sqrt (1+x*x))+    acosh x = log (x + (x+1) * sqrt ((x-1)/(x+1)))+    atanh x = log ((x+1) / sqrt (1 - x*x))++instance  RealFrac Double where+    properFraction x =+        case decodeFloat x of+	  (m,n) -> if n >= 0 then+			(fromInteger m * fromInteger (floatRadix x) ^ n, 0)+		    else+			case quotRem m ((floatRadix x)^(negate n)) of+		          (w,r) -> (fromInteger w, encodeFloat r n)+++instance  RealFloat Double  where+    floatRadix    = primDoubleRadix +    floatDigits   = primDoubleDigits+    floatRange    = primDoubleRange+    decodeFloat x = primDecodeDouble x+    encodeFloat x y = primEncodeDouble x y++    isNaN 	   = primDoubleIsNaN+    isInfinite     = primDoubleIsInfinite+    isDenormalized = primDoubleIsDenormalized+    isNegativeZero = primDoubleIsNegativeZero+    isIEEE         = primDoubleIsIEEE++-- The Enum instances for Floats and Doubles are slightly unusual.+-- The `toEnum' function truncates numbers to Int.  The definitions+-- of enumFrom and enumFromThen allow floats to be used in arithmetic+-- series: [0,0.1 .. 0.95].  However, roundoff errors make these somewhat+-- dubious.  This example may have either 10 or 11 elements, depending on+-- how 0.1 is represented.+++instance  Enum Float  where+    succ x           =  x+1+    pred x           =  x-1+    toEnum           =  fromIntegral+    fromEnum         =  fromInteger . truncate   -- may overflow+    enumFrom         =  numericEnumFrom+    enumFromThen     =  numericEnumFromThen+    enumFromTo       =  numericEnumFromTo+    enumFromThenTo   =  numericEnumFromThenTo+++instance  Enum Double  where+    succ x           =  x+1+    pred x           =  x-1+    toEnum           =  fromIntegral+    fromEnum         =  fromInteger . truncate   -- may overflow+    enumFrom         =  numericEnumFrom+    enumFromThen     =  numericEnumFromThen+    enumFromTo       =  numericEnumFromTo+    enumFromThenTo   =  numericEnumFromThenTo+++numericEnumFrom         :: (Fractional a) => a -> [a]++numericEnumFromThen     :: (Fractional a) => a -> a -> [a]++numericEnumFromTo       :: (Fractional a, Ord a) => a -> a -> [a]++numericEnumFromThenTo   :: (Fractional a, Ord a) => a -> a -> a -> [a]+numericEnumFrom         =  iterate (+1)+numericEnumFromThen n m =  iterate (+(m-n)) n+numericEnumFromTo n m   =  takeWhile (<= m+1/2) (numericEnumFrom n)+numericEnumFromThenTo n n' m = takeWhile p (numericEnumFromThen n n')+                             where+                               p | n' > n    = (<= m + (n'-n)/2)+                                 | otherwise = (>= m + (n'-n)/2)++-- Lists++-- This data declaration is not legal Haskell+-- but it indicates the idea++-- data  [] a =  [] | a : [a]  deriving (Eq, Ord)++instance Eq a => Eq [a] where+  []     == []     = True+  (a:as) == (b:bs) = a == b && as == bs+  _      == _      = False++instance Ord a => Ord [a] where+  compare []     []     = EQ+  compare []     (b:bs) = LT+  compare (a:as) []     = GT+  compare (a:as) (b:bs) =+    case compare a b of+    	LT -> LT+	EQ -> compare as bs+	GT -> GT+++instance Functor [] where+    fmap = map+++instance  Monad []  where+    m >>= k          = concat (map k m)+    return x         = [x]+    fail s           = []++-- Tuples++-- data (,) a b = (,) a b+--   deriving (Eq, Ord, Bounded)++-- the types are defined in Hat to refer to them via T+-- hence instances cannot be derived++instance (Eq a,Eq b) => Eq (a,b) where+  (a,b) == (a',b') = a == a' && b == b'++instance (Ord a,Ord b) => Ord (a,b) where+  compare (a,b) (a',b') =+    case compare a a' of+    	LT -> LT+	EQ -> compare b b'+	GT -> GT++instance (Bounded a, Bounded b) => Bounded (a,b) where+  minBound = (minBound, minBound)+  maxBound = (maxBound, maxBound)+++instance (Eq a,Eq b,Eq c) => Eq (a,b,c) where+  (a,b,c) == (a',b',c') = a == a' && b == b' && c == c'++instance (Ord a,Ord b,Ord c) => Ord (a,b,c) where+  compare (a,b,c) (a',b',c') =+    case compare a a' of+	EQ -> case compare b b' of+                EQ -> compare c c'+                x  -> x+	x  -> x++instance (Bounded a,Bounded b,Bounded c) => Bounded (a,b,c) where+  minBound = (minBound,minBound,minBound)+  maxBound = (maxBound,maxBound,maxBound)+++instance (Eq a,Eq b,Eq c,Eq d) => Eq (a,b,c,d) where+  (a,b,c,d) == (a',b',c',d') = a == a' && b == b' && c == c' && d == d'++instance (Ord a,Ord b,Ord c,Ord d) => Ord (a,b,c,d) where+  compare (a,b,c,d) (a',b',c',d') =+    case compare a a' of+	EQ -> case compare b b' of+                EQ -> case compare c c' of+                        EQ -> compare d d'+                        x  -> x+                x  -> x+	x  -> x++instance (Bounded a,Bounded b,Bounded c,Bounded d) => Bounded (a,b,c,d) where+  minBound = (minBound,minBound,minBound,minBound)+  maxBound = (maxBound,maxBound,maxBound,maxBound)+++instance (Eq a,Eq b,Eq c,Eq d,Eq e) => Eq (a,b,c,d,e) where+  (a,b,c,d,e) == (a',b',c',d',e') = +    a == a' && b == b' && c == c' && d == d' && e == e'++instance (Ord a,Ord b,Ord c,Ord d,Ord e) => Ord (a,b,c,d,e) where+  compare (a,b,c,d,e) (a',b',c',d',e') =+    case compare a a' of+	EQ -> case compare b b' of+                EQ -> case compare c c' of+                        EQ -> case compare d d' of+                                EQ -> compare e e'+                                x  -> x+                        x  -> x+                x  -> x+	x  -> x++instance (Bounded a,Bounded b,Bounded c,Bounded d,Bounded e) +  => Bounded (a,b,c,d,e) where+  minBound = (minBound,minBound,minBound,minBound,minBound)+  maxBound = (maxBound,maxBound,maxBound,maxBound,maxBound)+++instance (Eq a,Eq b,Eq c,Eq d,Eq e,Eq f) => Eq (a,b,c,d,e,f) where+  (a,b,c,d,e,f) == (a',b',c',d',e',f') = +    a == a' && b == b' && c == c' && d == d' && e == e' && f == f'++instance (Ord a,Ord b,Ord c,Ord d,Ord e,Ord f) => Ord (a,b,c,d,e,f) where+  compare (a,b,c,d,e,f) (a',b',c',d',e',f') =+    case compare a a' of+	EQ -> case compare b b' of+                EQ -> case compare c c' of+                        EQ -> case compare d d' of+                                EQ -> case compare e e' of+                                        EQ -> compare f f'+                                        x  -> x+                                x  -> x+                        x  -> x+                x  -> x+	x  -> x++instance (Bounded a,Bounded b,Bounded c,Bounded d,Bounded e,Bounded f) +  => Bounded (a,b,c,d,e,f) where+  minBound = (minBound,minBound,minBound,minBound,minBound,minBound)+  maxBound = (maxBound,maxBound,maxBound,maxBound,maxBound,maxBound)+++instance (Eq a,Eq b,Eq c,Eq d,Eq e,Eq f,Eq g) => Eq (a,b,c,d,e,f,g) where+  (a,b,c,d,e,f,g) == (a',b',c',d',e',f',g') = +    a == a' && b == b' && c == c' && d == d' && e == e' && f == f' && g == g'++instance (Ord a,Ord b,Ord c,Ord d,Ord e,Ord f,Ord g) +  => Ord (a,b,c,d,e,f,g) where+  compare (a,b,c,d,e,f,g) (a',b',c',d',e',f',g') =+    case compare a a' of+	EQ -> case compare b b' of+                EQ -> case compare c c' of+                        EQ -> case compare d d' of+                                EQ -> case compare e e' of+                                        EQ -> case compare f f' of+                                                EQ -> compare g g'+                                                x  -> x+                                        x  -> x+                                x  -> x+                        x  -> x+                x  -> x+	x  -> x++instance (Bounded a,Bounded b,Bounded c,Bounded d,Bounded e,Bounded f+         ,Bounded g) +  => Bounded (a,b,c,d,e,f,g) where+  minBound = (minBound,minBound,minBound,minBound,minBound,minBound,minBound)+  maxBound = (maxBound,maxBound,maxBound,maxBound,maxBound,maxBound,maxBound)+++instance (Eq a,Eq b,Eq c,Eq d,Eq e,Eq f,Eq g,Eq h) +  => Eq (a,b,c,d,e,f,g,h) where+  (a,b,c,d,e,f,g,h) == (a',b',c',d',e',f',g',h') = +    a == a' && b == b' && c == c' && d == d' && e == e' && f == f' && g == g'+    && h == h'++instance (Ord a,Ord b,Ord c,Ord d,Ord e,Ord f,Ord g,Ord h) +  => Ord (a,b,c,d,e,f,g,h) where+  compare (a,b,c,d,e,f,g,h) (a',b',c',d',e',f',g',h') =+    case compare a a' of+	EQ -> case compare b b' of+                EQ -> case compare c c' of+                        EQ -> case compare d d' of+                                EQ -> case compare e e' of+                                        EQ -> case compare f f' of+                                                EQ -> case compare g g' of+                                                        EQ -> compare h h'+                                                x  -> x+                                        x  -> x+                                x  -> x+                        x  -> x+                x  -> x+	x  -> x++instance (Bounded a,Bounded b,Bounded c,Bounded d,Bounded e,Bounded f+         ,Bounded g,Bounded h) +  => Bounded (a,b,c,d,e,f,g,h) where+  minBound = (minBound,minBound,minBound,minBound,minBound,minBound,minBound+             ,minBound)+  maxBound = (maxBound,maxBound,maxBound,maxBound,maxBound,maxBound,maxBound+             ,maxBound)++instance (Eq a,Eq b,Eq c,Eq d,Eq e,Eq f,Eq g,Eq h,Eq i) +  => Eq (a,b,c,d,e,f,g,h,i) where+  (a,b,c,d,e,f,g,h,i) == (a',b',c',d',e',f',g',h',i') = +    a == a' && b == b' && c == c' && d == d' && e == e' && f == f' && g == g'+    && h == h' && i == i'++instance (Ord a,Ord b,Ord c,Ord d,Ord e,Ord f,Ord g,Ord h,Ord i) +  => Ord (a,b,c,d,e,f,g,h,i) where+  compare (a,b,c,d,e,f,g,h,i) (a',b',c',d',e',f',g',h',i') =+    case compare a a' of+     EQ -> case compare b b' of+      EQ -> case compare c c' of+       EQ -> case compare d d' of+        EQ -> case compare e e' of+         EQ -> case compare f f' of+          EQ -> case compare g g' of+           EQ -> case compare h h' of+            EQ -> compare i i'+            x  -> x+           x  -> x+          x  -> x+         x  -> x+        x  -> x+       x  -> x+      x  -> x++instance (Bounded a,Bounded b,Bounded c,Bounded d,Bounded e,Bounded f+         ,Bounded g,Bounded h,Bounded i) +  => Bounded (a,b,c,d,e,f,g,h,i) where+  minBound = (minBound,minBound,minBound,minBound,minBound,minBound,minBound+             ,minBound,minBound)+  maxBound = (maxBound,maxBound,maxBound,maxBound,maxBound,maxBound,maxBound+             ,maxBound,maxBound)+++instance (Eq a,Eq b,Eq c,Eq d,Eq e,Eq f,Eq g,Eq h,Eq i,Eq j) +  => Eq (a,b,c,d,e,f,g,h,i,j) where+  (a,b,c,d,e,f,g,h,i,j) == (a',b',c',d',e',f',g',h',i',j') = +    a == a' && b == b' && c == c' && d == d' && e == e' && f == f' && g == g'+    && h == h' && i == i' && j == j'++instance (Ord a,Ord b,Ord c,Ord d,Ord e,Ord f,Ord g,Ord h,Ord i,Ord j) +  => Ord (a,b,c,d,e,f,g,h,i,j) where+  compare (a,b,c,d,e,f,g,h,i,j) (a',b',c',d',e',f',g',h',i',j') =+    case compare a a' of+     EQ -> case compare b b' of+      EQ -> case compare c c' of+       EQ -> case compare d d' of+        EQ -> case compare e e' of+         EQ -> case compare f f' of+          EQ -> case compare g g' of+           EQ -> case compare h h' of+            EQ -> case compare i i' of+             EQ -> compare j j'+             x  -> x+            x  -> x+           x  -> x+          x  -> x+         x  -> x+        x  -> x+       x  -> x+      x  -> x++instance (Bounded a,Bounded b,Bounded c,Bounded d,Bounded e,Bounded f+         ,Bounded g,Bounded h,Bounded i,Bounded j) +  => Bounded (a,b,c,d,e,f,g,h,i,j) where+  minBound = (minBound,minBound,minBound,minBound,minBound,minBound,minBound+             ,minBound,minBound,minBound)+  maxBound = (maxBound,maxBound,maxBound,maxBound,maxBound,maxBound,maxBound+             ,maxBound,maxBound,maxBound)+++instance (Eq a,Eq b,Eq c,Eq d,Eq e,Eq f,Eq g,Eq h,Eq i,Eq j,Eq k) +  => Eq (a,b,c,d,e,f,g,h,i,j,k) where+  (a,b,c,d,e,f,g,h,i,j,k) == (a',b',c',d',e',f',g',h',i',j',k') = +    a == a' && b == b' && c == c' && d == d' && e == e' && f == f' && g == g'+    && h == h' && i == i' && j == j' && k == k'++instance (Ord a,Ord b,Ord c,Ord d,Ord e,Ord f,Ord g,Ord h,Ord i,Ord j,Ord k) +  => Ord (a,b,c,d,e,f,g,h,i,j,k) where+  compare (a,b,c,d,e,f,g,h,i,j,k) (a',b',c',d',e',f',g',h',i',j',k') =+    case compare a a' of+     EQ -> case compare b b' of+      EQ -> case compare c c' of+       EQ -> case compare d d' of+        EQ -> case compare e e' of+         EQ -> case compare f f' of+          EQ -> case compare g g' of+           EQ -> case compare h h' of+            EQ -> case compare i i' of+             EQ -> case compare j j' of+              EQ -> compare k k'+              x  -> x+             x  -> x+            x  -> x+           x  -> x+          x  -> x+         x  -> x+        x  -> x+       x  -> x+      x  -> x++instance (Bounded a,Bounded b,Bounded c,Bounded d,Bounded e,Bounded f+         ,Bounded g,Bounded h,Bounded i,Bounded j,Bounded k) +  => Bounded (a,b,c,d,e,f,g,h,i,j,k) where+  minBound = (minBound,minBound,minBound,minBound,minBound,minBound,minBound+             ,minBound,minBound,minBound,minBound)+  maxBound = (maxBound,maxBound,maxBound,maxBound,maxBound,maxBound,maxBound+             ,maxBound,maxBound,maxBound,maxBound)+++instance (Eq a,Eq b,Eq c,Eq d,Eq e,Eq f,Eq g,Eq h,Eq i,Eq j,Eq k,Eq l) +  => Eq (a,b,c,d,e,f,g,h,i,j,k,l) where+  (a,b,c,d,e,f,g,h,i,j,k,l) == (a',b',c',d',e',f',g',h',i',j',k',l') = +    a == a' && b == b' && c == c' && d == d' && e == e' && f == f' && g == g'+    && h == h' && i == i' && j == j' && k == k' && l == l'++instance (Ord a,Ord b,Ord c,Ord d,Ord e,Ord f,Ord g,Ord h,Ord i,Ord j,Ord k+         ,Ord l) +  => Ord (a,b,c,d,e,f,g,h,i,j,k,l) where+  compare (a,b,c,d,e,f,g,h,i,j,k,l) (a',b',c',d',e',f',g',h',i',j',k',l') =+    case compare a a' of+     EQ -> case compare b b' of+      EQ -> case compare c c' of+       EQ -> case compare d d' of+        EQ -> case compare e e' of+         EQ -> case compare f f' of+          EQ -> case compare g g' of+           EQ -> case compare h h' of+            EQ -> case compare i i' of+             EQ -> case compare j j' of+              EQ -> case compare k k' of+                EQ -> compare l l'+                x  -> x+              x  -> x+             x  -> x+            x  -> x+           x  -> x+          x  -> x+         x  -> x+        x  -> x+       x  -> x+      x  -> x++instance (Bounded a,Bounded b,Bounded c,Bounded d,Bounded e,Bounded f+         ,Bounded g,Bounded h,Bounded i,Bounded j,Bounded k,Bounded l) +  => Bounded (a,b,c,d,e,f,g,h,i,j,k,l) where+  minBound = (minBound,minBound,minBound,minBound,minBound,minBound,minBound+             ,minBound,minBound,minBound,minBound,minBound)+  maxBound = (maxBound,maxBound,maxBound,maxBound,maxBound,maxBound,maxBound+             ,maxBound,maxBound,maxBound,maxBound,maxBound)+++instance (Eq a,Eq b,Eq c,Eq d,Eq e,Eq f,Eq g,Eq h,Eq i,Eq j,Eq k,Eq l,Eq m) +  => Eq (a,b,c,d,e,f,g,h,i,j,k,l,m) where+  (a,b,c,d,e,f,g,h,i,j,k,l,m) == (a',b',c',d',e',f',g',h',i',j',k',l',m') = +    a == a' && b == b' && c == c' && d == d' && e == e' && f == f' && g == g'+    && h == h' && i == i' && j == j' && k == k' && l == l' && m == m'++instance (Ord a,Ord b,Ord c,Ord d,Ord e,Ord f,Ord g,Ord h,Ord i,Ord j,Ord k+         ,Ord l,Ord m) +  => Ord (a,b,c,d,e,f,g,h,i,j,k,l,m) where+  compare (a,b,c,d,e,f,g,h,i,j,k,l,m) +    (a',b',c',d',e',f',g',h',i',j',k',l',m') =+    case compare a a' of+     EQ -> case compare b b' of+      EQ -> case compare c c' of+       EQ -> case compare d d' of+        EQ -> case compare e e' of+         EQ -> case compare f f' of+          EQ -> case compare g g' of+           EQ -> case compare h h' of+            EQ -> case compare i i' of+             EQ -> case compare j j' of+              EQ -> case compare k k' of+               EQ -> case compare l l' of+                EQ -> compare m m'+                x  -> x+               x  -> x+              x  -> x+             x  -> x+            x  -> x+           x  -> x+          x  -> x+         x  -> x+        x  -> x+       x  -> x+      x  -> x++instance (Bounded a,Bounded b,Bounded c,Bounded d,Bounded e,Bounded f+         ,Bounded g,Bounded h,Bounded i,Bounded j,Bounded k,Bounded l+         ,Bounded m) +  => Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m) where+  minBound = (minBound,minBound,minBound,minBound,minBound,minBound,minBound+             ,minBound,minBound,minBound,minBound,minBound,minBound)+  maxBound = (maxBound,maxBound,maxBound,maxBound,maxBound,maxBound,maxBound+             ,maxBound,maxBound,maxBound,maxBound,maxBound,maxBound)++instance (Eq a,Eq b,Eq c,Eq d,Eq e,Eq f,Eq g,Eq h,Eq i,Eq j,Eq k,Eq l,Eq m+         ,Eq n) +  => Eq (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where+  (a,b,c,d,e,f,g,h,i,j,k,l,m,n) == +    (a',b',c',d',e',f',g',h',i',j',k',l',m',n') = +    a == a' && b == b' && c == c' && d == d' && e == e' && f == f' && g == g'+    && h == h' && i == i' && j == j' && k == k' && l == l' && m == m' +    && n == n'++instance (Ord a,Ord b,Ord c,Ord d,Ord e,Ord f,Ord g,Ord h,Ord i,Ord j,Ord k+         ,Ord l,Ord m,Ord n) +  => Ord (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where+  compare (a,b,c,d,e,f,g,h,i,j,k,l,m,n) +    (a',b',c',d',e',f',g',h',i',j',k',l',m',n') =+    case compare a a' of+     EQ -> case compare b b' of+      EQ -> case compare c c' of+       EQ -> case compare d d' of+        EQ -> case compare e e' of+         EQ -> case compare f f' of+          EQ -> case compare g g' of+           EQ -> case compare h h' of+            EQ -> case compare i i' of+             EQ -> case compare j j' of+              EQ -> case compare k k' of+               EQ -> case compare l l' of+                EQ -> case compare m m' of+                 EQ -> compare n n'+                 x  -> x+                x  -> x+               x  -> x+              x  -> x+             x  -> x+            x  -> x+           x  -> x+          x  -> x+         x  -> x+        x  -> x+       x  -> x+      x  -> x++instance (Bounded a,Bounded b,Bounded c,Bounded d,Bounded e,Bounded f+         ,Bounded g,Bounded h,Bounded i,Bounded j,Bounded k,Bounded l+         ,Bounded m,Bounded n) +  => Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where+  minBound = (minBound,minBound,minBound,minBound,minBound,minBound,minBound+             ,minBound,minBound,minBound,minBound,minBound,minBound,minBound)+  maxBound = (maxBound,maxBound,maxBound,maxBound,maxBound,maxBound,maxBound+             ,maxBound,maxBound,maxBound,maxBound,maxBound,maxBound,maxBound)+++instance (Eq a,Eq b,Eq c,Eq d,Eq e,Eq f,Eq g,Eq h,Eq i,Eq j,Eq k,Eq l,Eq m+         ,Eq n,Eq o) +  => Eq (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where+  (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) == +    (a',b',c',d',e',f',g',h',i',j',k',l',m',n',o') = +    a == a' && b == b' && c == c' && d == d' && e == e' && f == f' && g == g'+    && h == h' && i == i' && j == j' && k == k' && l == l' && m == m' +    && n == n' && o == o'++instance (Ord a,Ord b,Ord c,Ord d,Ord e,Ord f,Ord g,Ord h,Ord i,Ord j,Ord k+         ,Ord l,Ord m,Ord n,Ord o) +  => Ord (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where+  compare (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) +    (a',b',c',d',e',f',g',h',i',j',k',l',m',n',o') =+    case compare a a' of+     EQ -> case compare b b' of+      EQ -> case compare c c' of+       EQ -> case compare d d' of+        EQ -> case compare e e' of+         EQ -> case compare f f' of+          EQ -> case compare g g' of+           EQ -> case compare h h' of+            EQ -> case compare i i' of+             EQ -> case compare j j' of+              EQ -> case compare k k' of+               EQ -> case compare l l' of+                EQ -> case compare m m' of+                 EQ -> case compare n n' of+                  EQ -> compare o o'+                  x  -> x+                 x  -> x+                x  -> x+               x  -> x+              x  -> x+             x  -> x+            x  -> x+           x  -> x+          x  -> x+         x  -> x+        x  -> x+       x  -> x+      x  -> x++instance (Bounded a,Bounded b,Bounded c,Bounded d,Bounded e,Bounded f+         ,Bounded g,Bounded h,Bounded i,Bounded j,Bounded k,Bounded l+         ,Bounded m,Bounded n,Bounded o) +  => Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where+  minBound = (minBound,minBound,minBound,minBound,minBound,minBound,minBound+             ,minBound,minBound,minBound,minBound,minBound,minBound,minBound+             ,minBound)+  maxBound = (maxBound,maxBound,maxBound,maxBound,maxBound,maxBound,maxBound+             ,maxBound,maxBound,maxBound,maxBound,maxBound,maxBound,maxBound+             ,maxBound)+++-- component projections for pairs:+-- (NB: not provided for triples, quadruples, etc.)++fst              :: (a,b) -> a+fst (x,y)        =  x+++snd              :: (a,b) -> b+snd (x,y)        =  y++-- curry converts an uncurried function to a curried function;+-- uncurry converts a curried function to a function on pairs.++curry            :: ((a, b) -> c) -> a -> b -> c+curry f x y      =  f (x, y)+++uncurry          :: (a -> b -> c) -> ((a, b) -> c)+uncurry f p      =  f (fst p) (snd p)++-- Misc functions++-- until p f  yields the result of applying f until p holds.++until            :: (a -> Bool) -> (a -> a) -> a -> a+until p f x +     | p x       =  x+     | otherwise =  until p f (f x)++-- asTypeOf is a type-restricted version of const.  It is usually used+-- as an infix operator, and its typing forces its first argument+-- (which is usually overloaded) to have the same type as the second.++asTypeOf         :: a -> a -> a+asTypeOf         =  const++-- error stops execution and displays an error message+++-- error            :: String -> a+-- error            =  primError++-- It is expected that compilers will recognize this and insert error+-- messages that are more appropriate to the context in which undefined +-- appears. +++-- undefined        :: a+-- undefined        =  error "Prelude.undefined"++++-- A.1  Prelude PreludeList+-- Standard list functions+-- module PreludeList (+--    map, (++), filter, concat,+--    head, last, tail, init, null, length, (!!), +--    foldl, foldl1, scanl, scanl1, foldr, foldr1, scanr, scanr1,+--    iterate, repeat, replicate, cycle,+--    take, drop, splitAt, takeWhile, dropWhile, span, break,+--    lines, words, unlines, unwords, reverse, and, or,+--    any, all, elem, notElem, lookup,+--    sum, product, maximum, minimum, concatMap, +--    zip, zip3, zipWith, zipWith3, unzip, unzip3)+--  where+++-- HACK: for desugared list comprehensions++_foldr :: (a -> b -> b) -> [a] -> b -> b+_foldr f [] d = d+_foldr f ((:) x xs) d = f x (_foldr f xs d)++_filter :: Bool -> ([a]->[a]) -> [a] -> [a]+_filter b e r = if b then e r else r+++infixl 9  !!+infixr 5  +++infix  4  `elem`, `notElem`++-- Map and append++map :: (a -> b) -> [a] -> [b]+map f []     = []+map f (x:xs) = f x : map f xs+++(++) :: [a] -> [a] -> [a]+[]     ++ ys = ys+(x:xs) ++ ys = x : (xs ++ ys)+++filter :: (a -> Bool) -> [a] -> [a]+filter p [] = []+filter p (x:xs) | p x       = x : filter p xs+                | otherwise = filter p xs+++concat :: [[a]] -> [a]+concat xss = foldr (++) [] xss+++-- head and tail extract the first element and remaining elements,+-- respectively, of a list, which must be non-empty.  last and init+-- are the dual functions working from the end of a finite list,+-- rather than the beginning.+++head             :: [a] -> a+head (x:_)       =  x+head []          =  error "Prelude.head: empty list"+++last             :: [a] -> a+last [x]         =  x+last (_:xs)      =  last xs+last []          =  error "Prelude.last: empty list"+++tail             :: [a] -> [a]+tail (_:xs)      =  xs+tail []          =  error "Prelude.tail: empty list"+++init             :: [a] -> [a]+init [x]         =  []+init (x:xs)      =  x : init xs+init []          =  error "Prelude.init: empty list"+++null             :: [a] -> Bool+null []          =  True+null (_:_)       =  False++-- length returns the length of a finite list as an Int.++length           :: [a] -> Int+length []        =  0+length (_:l)     =  1 + length l++-- List index (subscript) operator, 0-origin++(!!)                :: [a] -> Int -> a+xs     !! n | n < 0 =  error "Prelude.!!: negative index"+[]     !! _         =  error "Prelude.!!: index too large"+(x:_)  !! 0         =  x+(_:xs) !! n         =  xs !! (n-1)++-- foldl, applied to a binary operator, a starting value (typically the+-- left-identity of the operator), and a list, reduces the list using+-- the binary operator, from left to right:+--  foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn+-- foldl1 is a variant that has no starting value argument, and  thus must+-- be applied to non-empty lists.  scanl is similar to foldl, but returns+-- a list of successive reduced values from the left:+--      scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]+-- Note that  last (scanl f z xs) == foldl f z xs.+-- scanl1 is similar, again without the starting element:+--      scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]+++foldl            :: (a -> b -> a) -> a -> [b] -> a+foldl f z []     =  z+foldl f z (x:xs) =  foldl f (f z x) xs+++foldl1           :: (a -> a -> a) -> [a] -> a+foldl1 f (x:xs)  =  foldl f x xs+foldl1 _ []      =  error "Prelude.foldl1: empty list"+++scanl            :: (a -> b -> a) -> a -> [b] -> [a]+scanl f q xs     =  q : (case xs of+                            []   -> []+                            x:xs -> scanl f (f q x) xs)+++scanl1           :: (a -> a -> a) -> [a] -> [a]+scanl1 f (x:xs)  =  scanl f x xs+scanl1 _ []      =  []++-- foldr, foldr1, scanr, and scanr1 are the right-to-left duals of the+-- above functions.+++foldr            :: (a -> b -> b) -> b -> [a] -> b+foldr f z []     =  z+foldr f z (x:xs) =  f x (foldr f z xs)+++foldr1           :: (a -> a -> a) -> [a] -> a+foldr1 f [x]     =  x+foldr1 f (x:xs)  =  f x (foldr1 f xs)+foldr1 _ []      =  error "Prelude.foldr1: empty list"+++scanr             :: (a -> b -> b) -> b -> [a] -> [b]+scanr f q0 []     =  [q0]+scanr f q0 (x:xs) =  f x q : qs+                     where qs@(q:_) = scanr f q0 xs +++scanr1          :: (a -> a -> a) -> [a] -> [a]+scanr1 f []     =  []+scanr1 f [x]    =  [x]+scanr1 f (x:xs) =  f x q : qs+                   where qs@(q:_) = scanr1 f xs ++-- iterate f x returns an infinite list of repeated applications of f to x:+-- iterate f x == [x, f x, f (f x), ...]++iterate          :: (a -> a) -> a -> [a]+iterate f x      =  x : iterate f (f x)++-- repeat x is an infinite list, with x the value of every element.++repeat           :: a -> [a]+repeat x         =  xs where xs = x:xs++-- replicate n x is a list of length n with x the value of every element++replicate        :: Int -> a -> [a]+replicate n x    =  take n (repeat x)++-- cycle ties a finite list into a circular one, or equivalently,+-- the infinite repetition of the original list.  It is the identity+-- on infinite lists.+++cycle            :: [a] -> [a]+cycle []         =  error "Prelude.cycle: empty list"+cycle xs         =  xs' where xs' = xs ++ xs'++-- take n, applied to a list xs, returns the prefix of xs of length n,+-- or xs itself if n > length xs.  drop n xs returns the suffix of xs+-- after the first n elements, or [] if n > length xs.  splitAt n xs+-- is equivalent to (take n xs, drop n xs).+++take                   :: Int -> [a] -> [a]+take n _      | n <= 0 =  []+take _ []              =  []+take n (x:xs)          =  x : take (n-1) xs+++drop                   :: Int -> [a] -> [a]+drop n xs     | n <= 0 =  xs+drop _ []              =  []+drop n (_:xs)          =  drop (n-1) xs+++splitAt                  :: Int -> [a] -> ([a],[a])+splitAt n xs             =  (take n xs, drop n xs)++-- takeWhile, applied to a predicate p and a list xs, returns the longest+-- prefix (possibly empty) of xs of elements that satisfy p.  dropWhile p xs+-- returns the remaining suffix.  span p xs is equivalent to +-- (takeWhile p xs, dropWhile p xs), while break p uses the negation of p.+++takeWhile               :: (a -> Bool) -> [a] -> [a]+takeWhile p []          =  []+takeWhile p (x:xs) +            | p x       =  x : takeWhile p xs+            | otherwise =  []+++dropWhile               :: (a -> Bool) -> [a] -> [a]+dropWhile p []          =  []+dropWhile p xs@(x:xs')+            | p x       =  dropWhile p xs'+            | otherwise =  xs+++span, break             :: (a -> Bool) -> [a] -> ([a],[a])+span p []            = ([],[])+span p xs@(x:xs') +            | p x       =  (x:ys,zs) +            | otherwise =  ([],xs)+                           where (ys,zs) = span p xs'++break p                 =  span (not . p)++-- lines breaks a string up into a list of strings at newline characters.+-- The resulting strings do not contain newlines.  Similary, words+-- breaks a string up into a list of words, which were delimited by+-- white space.  unlines and unwords are the inverse operations.+-- unlines joins lines with terminating newlines, and unwords joins+-- words with separating spaces.+++lines            :: String -> [String]+lines ""         =  []+lines s          =  let (l, s') = break (== '\n') s+                      in  l : case s' of+                                []      -> []+                                (_:s'') -> lines s''+++words            :: String -> [String]+words s          =  case dropWhile isSpace s of+                      "" -> []+                      s' -> w : words s''+                            where (w, s'') = break isSpace s'+++unlines          :: [String] -> String+unlines          =  concatMap (++ "\n")+++unwords          :: [String] -> String+unwords []       =  ""+unwords ws       =  foldr1 (\w s -> w ++ ' ':s) ws++-- reverse xs returns the elements of xs in reverse order.  xs must be finite.++reverse          :: [a] -> [a]+reverse          =  foldl (flip (:)) []++-- and returns the conjunction of a Boolean list.  For the result to be+-- True, the list must be finite; False, however, results from a False+-- value at a finite index of a finite or infinite list.  or is the+-- disjunctive dual of and.++and, or          :: [Bool] -> Bool+and              =  foldr (&&) True+or               =  foldr (||) False++-- Applied to a predicate and a list, any determines if any element+-- of the list satisfies the predicate.  Similarly, for all.++any, all         :: (a -> Bool) -> [a] -> Bool+any p            =  or . map p+all p            =  and . map p++-- elem is the list membership predicate, usually written in infix form,+-- e.g., x `elem` xs.  notElem is the negation.++elem, notElem    :: (Eq a) => a -> [a] -> Bool+elem x           =  any (== x)+notElem x        =  all (/= x)++-- lookup key assocs looks up a key in an association list.++lookup           :: (Eq a) => a -> [(a,b)] -> Maybe b+lookup key []    =  Nothing+lookup key ((x,y):xys)+    | key == x   =  Just y+    | otherwise  =  lookup key xys++-- sum and product compute the sum or product of a finite list of numbers.++sum, product     :: (Num a) => [a] -> a+sum              =  foldl (+) 0  +product          =  foldl (*) 1++-- maximum and minimum return the maximum or minimum value from a list,+-- which must be non-empty, finite, and of an ordered type.++maximum, minimum :: (Ord a) => [a] -> a+maximum []       =  error "Prelude.maximum: empty list"+maximum xs       =  foldl1 max xs++minimum []       =  error "Prelude.minimum: empty list"+minimum xs       =  foldl1 min xs+++concatMap        :: (a -> [b]) -> [a] -> [b]+concatMap f      =  concat . map f++-- zip takes two lists and returns a list of corresponding pairs.  If one+-- input list is short, excess elements of the longer list are discarded.+-- zip3 takes three lists and returns a list of triples.  Zips for larger+-- tuples are in the List library+++zip              :: [a] -> [b] -> [(a,b)]+zip              =  zipWith (,)++zip3             :: [a] -> [b] -> [c] -> [(a,b,c)]+zip3             =  zipWith3 (,,)++-- The zipWith family generalises the zip family by zipping with the+-- function given as the first argument, instead of a tupling function.+-- For example, zipWith (+) is applied to two lists to produce the list+-- of corresponding sums.+++zipWith          :: (a->b->c) -> [a]->[b]->[c]+zipWith z (a:as) (b:bs)+                 =  z a b : zipWith z as bs+zipWith _ _ _    =  []+++zipWith3         :: (a->b->c->d) -> [a]->[b]->[c]->[d]+zipWith3 z (a:as) (b:bs) (c:cs)+                 =  z a b c : zipWith3 z as bs cs+zipWith3 _ _ _ _ =  []+++-- unzip transforms a list of pairs into a pair of lists.  +++unzip            :: [(a,b)] -> ([a],[b])+unzip            =  foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[])+++unzip3           :: [(a,b,c)] -> ([a],[b],[c])+unzip3           =  foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs))+                          ([],[],[])++-- A.2  Prelude PreludeText+-- module PreludeText (+--    ReadS, ShowS,+--    Read(readsPrec, readList),+--    Show(showsPrec, showList),+--    reads, shows, show, read, lex,+--    showChar, showString, readParen, showParen ) where++-- The instances of Read and Show for+-- Bool, Char, Maybe, Either, Ordering+-- are done via "deriving" clauses in Prelude.hs+++type  ReadS a  = String -> [(a,String)]++type  ShowS    = String -> String+++class  Read a  where+    readsPrec        :: Int -> ReadS a+    readList         :: ReadS [a]++-- Minimal complete definition:+-- readsPrec+    readList         = readParen False (\r -> [pr | ("[",s)  <- lex r,+                                                    pr       <- readl s])+                       where readl  s = [([],t)   | ("]",t)  <- lex s] +++                                        [(x:xs,u) | (x,t)    <- reads s,+                                                    (xs,u)   <- readl' t]+                             readl' s = [([],t)   | ("]",t)  <- lex s] +++                                        [(x:xs,v) | (",",t)  <- lex s,+                                                    (x,u)    <- reads t,+                                                    (xs,v)   <- readl' u]+++class  Show a  where+    showsPrec        :: Int -> a -> ShowS+    show             :: a -> String +    showList         :: [a] -> ShowS++-- Mimimal complete definition:+-- show or showsPrec+    showsPrec _ x s   = show x ++ s++    show x        = showsPrec 0 x ""++    showList []       = showString "[]"+    showList (x:xs)   = showChar '[' . shows x . showl xs+                        where showl []     = showChar ']'+                              showl (x:xs) = showChar ',' . shows x .+                                             showl xs++reads            :: (Read a) => ReadS a+reads            =  readsPrec 0+++shows            :: (Show a) => a -> ShowS+shows            =  showsPrec 0+++read             :: (Read a) => String -> a+read s           =  case [x | (x,t) <- reads s, ("","") <- lex t] of+                         [x] -> x+                         []  -> error "Prelude.read: no parse"+                         _   -> error "Prelude.read: ambiguous parse"+++showChar         :: Char -> ShowS+showChar         =  (:)+++showString       :: String -> ShowS+showString       =  (++)+++showParen        :: Bool -> ShowS -> ShowS+showParen b p    =  if b then showChar '(' . p . showChar ')' else p+++readParen        :: Bool -> ReadS a -> ReadS a+readParen b g    =  if b then mandatory else optional+                    where optional r  = g r ++ mandatory r+                          mandatory r = [(x,u) | ("(",s) <- lex r,+                                                 (x,t)   <- optional s,+                                                 (")",u) <- lex t    ]++-- This lexer is not completely faithful to the Haskell lexical syntax.+-- Current limitations:+--    Qualified names are not handled properly+--    Octal and hexidecimal numerics are not recognized as a single token+--    Comments are not treated properly+++lex              :: ReadS String+lex ""           =  [("","")]+lex (c:s)+   | isSpace c   =  lex (dropWhile isSpace s)+lex ('\'':s)     =  [('\'':ch++"'", t) | (ch,'\'':t)  <- lexLitChar s,+                                         ch /= "'" ]+lex ('"':s)      =  [('"':str, t)      | (str,t) <- lexString s]+                    where+                    lexString ('"':s) = [("\"",s)]+                    lexString s = [(ch++str, u)+                                         | (ch,t)  <- lexStrItem s,+                                           (str,u) <- lexString t  ]++                    lexStrItem ('\\':'&':s) =  [("\\&",s)]+                    lexStrItem ('\\':c:s) | isSpace c+                                           =  [("\\&",t) | +                                               '\\':t <-+                                                   [dropWhile isSpace s]]+                    lexStrItem s           =  lexLitChar s++lex (c:s) | isSingle c = [([c],s)]+          | isSym c    = [(c:sym,t)       | (sym,t) <- [span isSym s]]+          | isAlpha c  = [(c:nam,t)       | (nam,t) <- [span isIdChar s]]+          | isDigit c  = [(c:ds++fe,t)    | (ds,s)  <- [span isDigit s],+                                            (fe,t)  <- lexFracExp s     ]+          | otherwise  = []    -- bad character+             where+              isSingle c =  c `elem` ",;()[]{}_`"+              isSym c    =  c `elem` "!@#$%&*+./<=>?\\^|:-~"+              isIdChar c =  isAlphaNum c || c `elem` "_'"++              lexFracExp ('.':c:cs) | isDigit c+                            = [('.':ds++e,u) | (ds,t) <- lexDigits (c:cs),+                                               (e,u)  <- lexExp t]+              lexFracExp s  = lexExp s++              lexExp (e:s) | e `elem` "eE"+                       = [(e:c:ds,u) | (c:t)  <- [s], c `elem` "+-",+                                                 (ds,u) <- lexDigits t] +++                         [(e:ds,t)   | (ds,t) <- lexDigits s]+              lexExp s = [("",s)]+++instance  Show Int  where+    showsPrec n = showsPrec n . toInteger+-- Converting to Integer avoids+-- possible difficulty with minInt+++instance  Read Int  where+  readsPrec p r = [(fromInteger i, t) | (i,t) <- readsPrec p r]+-- Reading at the Integer type avoids+-- possible difficulty with minInt+++instance  Show Integer  where+    showsPrec           = showSigned showInt+++instance  Read Integer  where+    readsPrec p         = readSigned readDec+++instance  Show Float  where +    showsPrec p         = showFloat+           ++instance  Read Float  where+    readsPrec p         = readSigned readFloat+++instance  Show Double  where+    showsPrec p         = showFloat+++instance  Read Double  where+    readsPrec p         = readSigned readFloat+++instance  Show ()  where+    showsPrec p () = showString "()"+++instance Read () where+    readsPrec p    = readParen False+                            (\r -> [((),t) | ("(",s) <- lex r,+                                             (")",t) <- lex s ] )++instance  Show Char  where+    showsPrec p '\'' = showString "'\\''"+    showsPrec p c    = showChar '\'' . showLitChar c . showChar '\''++    showList cs = showChar '"' . showl cs+                 where showl ""       = showChar '"'+                       showl ('"':cs) = showString "\\\"" . showl cs+                       showl (c:cs)   = showLitChar c . showl cs+++instance  Read Char  where+    readsPrec p      = readParen False+                            (\r -> [(c,t) | ('\'':s,t)<- lex r,+                                            (c,"\'")  <- readLitChar s])++    readList = readParen False (\r -> [(l,t) | ('"':s, t) <- lex r,+                                               (l,_)      <- readl s ])+        where readl ('"':s)      = [("",s)]+              readl ('\\':'&':s) = readl s+              readl s            = [(c:cs,u) | (c ,t) <- readLitChar s,+                                               (cs,u) <- readl t       ]+++instance  (Show a) => Show [a]  where+    showsPrec p      = showList+++instance  (Read a) => Read [a]  where+    readsPrec p      = readList++-- Tuples+++instance  (Show a, Show b) => Show (a,b)  where+    showsPrec p (x,y) = showChar '(' . shows x . showChar ',' .+                                       shows y . showChar ')'+++instance  (Read a, Read b) => Read (a,b)  where+    readsPrec p       = readParen False+                            (\r -> [((x,y), w) | ("(",s) <- lex r,+                                                 (x,t)   <- reads s,+                                                 (",",u) <- lex t,+                                                 (y,v)   <- reads u,+                                                 (")",w) <- lex v ] )+++instance  (Read a, Read b, Read c) => Read (a,b,c)  where+    readsPrec p = readParen False+    	    	    	    (\r0 -> [((x1,x2,x3), w) | +					("(",s1) <- lex r0,+					(x1, r1) <- reads s1,+					(",",s2) <- lex r1,+					(x2, r2) <- reads s2,+					(",",s3) <- lex r2,+					(x3, r3) <- reads s3,+					(")",w)  <- lex r3 ] )++instance  (Read a, Read b, Read c, Read d) => Read (a,b,c,d)  where+    readsPrec p = readParen False+    	    	    	    (\r0 -> [((x1,x2,x3,x4), w) | +					("(",s1) <- lex r0,+					(x1, r1) <- reads s1,+					(",",s2) <- lex r1,+					(x2, r2) <- reads s2,+					(",",s3) <- lex r2,+					(x3, r3) <- reads s3,+					(",",s4) <- lex r3,+					(x4, r4) <- reads s4,+					(")",w)  <- lex r4 ] )++instance  (Read a, Read b, Read c, Read d, Read e) => Read (a,b,c,d,e)  where+    readsPrec p = readParen False+    	    	    	    (\r0 -> [((x1,x2,x3,x4,x5), w) | +					("(",s1) <- lex r0,+					(x1, r1) <- reads s1,+					(",",s2) <- lex r1,+					(x2, r2) <- reads s2,+					(",",s3) <- lex r2,+					(x3, r3) <- reads s3,+					(",",s4) <- lex r3,+					(x4, r4) <- reads s4,+					(",",s5) <- lex r4,+					(x5, r5) <- reads s5,+					(")",w)  <- lex r5 ] )++instance  (Read a, Read b, Read c, Read d, Read e, Read f) =>+	 Read (a,b,c,d,e,f)  where+    readsPrec p = readParen False+    	    	    	    (\r0 -> [((x1,x2,x3,x4,x5,x6), w) | +					("(",s1) <- lex r0,+					(x1, r1) <- reads s1,+					(",",s2) <- lex r1,+					(x2, r2) <- reads s2,+					(",",s3) <- lex r2,+					(x3, r3) <- reads s3,+					(",",s4) <- lex r3,+					(x4, r4) <- reads s4,+					(",",s5) <- lex r4,+					(x5, r5) <- reads s5,+					(",",s6) <- lex r5,+					(x6, r6) <- reads s6,+					(")",w)  <- lex r6 ] )++instance  (Read a, Read b, Read c, Read d, Read e, Read f, Read g) =>+	 Read (a,b,c,d,e,f,g)  where+    readsPrec p = readParen False+    	    	    	    (\r0 -> [((x1,x2,x3,x4,x5,x6,x7), w) | +					("(",s1) <- lex r0,+					(x1, r1) <- reads s1,+					(",",s2) <- lex r1,+					(x2, r2) <- reads s2,+					(",",s3) <- lex r2,+					(x3, r3) <- reads s3,+					(",",s4) <- lex r3,+					(x4, r4) <- reads s4,+					(",",s5) <- lex r4,+					(x5, r5) <- reads s5,+					(",",s6) <- lex r5,+					(x6, r6) <- reads s6,+					(",",s7) <- lex r6,+					(x7, r7) <- reads s7,+					(")",w)  <- lex r7 ] )++instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g,+	  Read h) =>+	 Read (a,b,c,d,e,f,g,h)  where+    readsPrec p = readParen False+    	    	    	    (\r0 -> [((x1,x2,x3,x4,x5,x6,x7,x8), w) | +					("(",s1) <- lex r0,+					(x1, r1) <- reads s1,+					(",",s2) <- lex r1,+					(x2, r2) <- reads s2,+					(",",s3) <- lex r2,+					(x3, r3) <- reads s3,+					(",",s4) <- lex r3,+					(x4, r4) <- reads s4,+					(",",s5) <- lex r4,+					(x5, r5) <- reads s5,+					(",",s6) <- lex r5,+					(x6, r6) <- reads s6,+					(",",s7) <- lex r6,+					(x7, r7) <- reads s7,+					(",",s8) <- lex r7,+					(x8, r8) <- reads s8,+					(")",w)  <- lex r8 ] )++instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g,+	  Read h, Read i) =>+	 Read (a,b,c,d,e,f,g,h,i)  where+    readsPrec p = readParen False+    	    	    	    (\r0 -> [((x1,x2,x3,x4,x5,x6,x7,x8,x9), w) | +					("(",s1) <- lex r0,+					(x1, r1) <- reads s1,+					(",",s2) <- lex r1,+					(x2, r2) <- reads s2,+					(",",s3) <- lex r2,+					(x3, r3) <- reads s3,+					(",",s4) <- lex r3,+					(x4, r4) <- reads s4,+					(",",s5) <- lex r4,+					(x5, r5) <- reads s5,+					(",",s6) <- lex r5,+					(x6, r6) <- reads s6,+					(",",s7) <- lex r6,+					(x7, r7) <- reads s7,+					(",",s8) <- lex r7,+					(x8, r8) <- reads s8,+					(",",s9) <- lex r8,+					(x9, r9) <- reads s9,+					(")",w)  <- lex r9 ] )++instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g,+	  Read h, Read i, Read j) =>+	 Read (a,b,c,d,e,f,g,h,i,j)  where+    readsPrec p = readParen False+    	    	    	    (\r0 -> [((x1,x2,x3,x4,x5,x6,x7,x8,x9,x10), w) | +					("(",s1) <- lex r0,+					(x1, r1) <- reads s1,+					(",",s2) <- lex r1,+					(x2, r2) <- reads s2,+					(",",s3) <- lex r2,+					(x3, r3) <- reads s3,+					(",",s4) <- lex r3,+					(x4, r4) <- reads s4,+					(",",s5) <- lex r4,+					(x5, r5) <- reads s5,+					(",",s6) <- lex r5,+					(x6, r6) <- reads s6,+					(",",s7) <- lex r6,+					(x7, r7) <- reads s7,+					(",",s8) <- lex r7,+					(x8, r8) <- reads s8,+					(",",s9) <- lex r8,+					(x9, r9) <- reads s9,+					(",",s10) <- lex r9,+					(x10, r10) <- reads s10,+					(")",w)  <- lex r10 ] )++instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g,+	  Read h, Read i, Read j, Read k) =>+	 Read (a,b,c,d,e,f,g,h,i,j,k)  where+    readsPrec p = readParen False+    	    	    (\r0 -> [((x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11), w) | +					("(",s1) <- lex r0,+					(x1, r1) <- reads s1,+					(",",s2) <- lex r1,+					(x2, r2) <- reads s2,+					(",",s3) <- lex r2,+					(x3, r3) <- reads s3,+					(",",s4) <- lex r3,+					(x4, r4) <- reads s4,+					(",",s5) <- lex r4,+					(x5, r5) <- reads s5,+					(",",s6) <- lex r5,+					(x6, r6) <- reads s6,+					(",",s7) <- lex r6,+					(x7, r7) <- reads s7,+					(",",s8) <- lex r7,+					(x8, r8) <- reads s8,+					(",",s9) <- lex r8,+					(x9, r9) <- reads s9,+					(",",s10) <- lex r9,+					(x10, r10) <- reads s10,+					(",",s11) <- lex r10,+					(x11, r11) <- reads s11,+					(")",w)  <- lex r11 ] )++instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g,+	  Read h, Read i, Read j, Read k, Read l) =>+	 Read (a,b,c,d,e,f,g,h,i,j,k,l)  where+    readsPrec p = readParen False+    	    	    (\r0 -> [((x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12), w) | +					("(",s1) <- lex r0,+					(x1, r1) <- reads s1,+					(",",s2) <- lex r1,+					(x2, r2) <- reads s2,+					(",",s3) <- lex r2,+					(x3, r3) <- reads s3,+					(",",s4) <- lex r3,+					(x4, r4) <- reads s4,+					(",",s5) <- lex r4,+					(x5, r5) <- reads s5,+					(",",s6) <- lex r5,+					(x6, r6) <- reads s6,+					(",",s7) <- lex r6,+					(x7, r7) <- reads s7,+					(",",s8) <- lex r7,+					(x8, r8) <- reads s8,+					(",",s9) <- lex r8,+					(x9, r9) <- reads s9,+					(",",s10) <- lex r9,+					(x10, r10) <- reads s10,+					(",",s11) <- lex r10,+					(x11, r11) <- reads s11,+					(",",s12) <- lex r11,+					(x12, r12) <- reads s12,+					(")",w)  <- lex r12 ] )++instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g,+	  Read h, Read i, Read j, Read k, Read l, Read m) =>+	 Read (a,b,c,d,e,f,g,h,i,j,k,l,m)  where+    readsPrec p = readParen False+    	    	    (\r0 -> [((x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13), w) | +					("(",s1) <- lex r0,+					(x1, r1) <- reads s1,+					(",",s2) <- lex r1,+					(x2, r2) <- reads s2,+					(",",s3) <- lex r2,+					(x3, r3) <- reads s3,+					(",",s4) <- lex r3,+					(x4, r4) <- reads s4,+					(",",s5) <- lex r4,+					(x5, r5) <- reads s5,+					(",",s6) <- lex r5,+					(x6, r6) <- reads s6,+					(",",s7) <- lex r6,+					(x7, r7) <- reads s7,+					(",",s8) <- lex r7,+					(x8, r8) <- reads s8,+					(",",s9) <- lex r8,+					(x9, r9) <- reads s9,+					(",",s10) <- lex r9,+					(x10, r10) <- reads s10,+					(",",s11) <- lex r10,+					(x11, r11) <- reads s11,+					(",",s12) <- lex r11,+					(x12, r12) <- reads s12,+					(",",s13) <- lex r12,+					(x13, r13) <- reads s13,+					(")",w)  <- lex r13 ] )++instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g,+	  Read h, Read i, Read j, Read k, Read l, Read m, Read n) =>+	 Read (a,b,c,d,e,f,g,h,i,j,k,l,m,n)  where+    readsPrec p = readParen False+    	    	    (\r0 -> [((x1,x2,x3,x4,x5,x6,x7+                              ,x8,x9,x10,x11,x12,x13,x14), w) | +					("(",s1) <- lex r0,+					(x1, r1) <- reads s1,+					(",",s2) <- lex r1,+					(x2, r2) <- reads s2,+					(",",s3) <- lex r2,+					(x3, r3) <- reads s3,+					(",",s4) <- lex r3,+					(x4, r4) <- reads s4,+					(",",s5) <- lex r4,+					(x5, r5) <- reads s5,+					(",",s6) <- lex r5,+					(x6, r6) <- reads s6,+					(",",s7) <- lex r6,+					(x7, r7) <- reads s7,+					(",",s8) <- lex r7,+					(x8, r8) <- reads s8,+					(",",s9) <- lex r8,+					(x9, r9) <- reads s9,+					(",",s10) <- lex r9,+					(x10, r10) <- reads s10,+					(",",s11) <- lex r10,+					(x11, r11) <- reads s11,+					(",",s12) <- lex r11,+					(x12, r12) <- reads s12,+					(",",s13) <- lex r12,+					(x13, r13) <- reads s13,+					(",",s14) <- lex r13,+					(x14, r14) <- reads s14,+					(")",w)  <- lex r14 ] )++instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g,+	  Read h, Read i, Read j, Read k, Read l, Read m, Read n, Read o) =>+	 Read (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)  where+    readsPrec p = readParen False+    	    	    (\r0 -> [((x1,x2,x3,x4,x5,x6,x7+                              ,x8,x9,x10,x11,x12,x13,x14,x15), w) | +					("(",s1) <- lex r0,+					(x1, r1) <- reads s1,+					(",",s2) <- lex r1,+					(x2, r2) <- reads s2,+					(",",s3) <- lex r2,+					(x3, r3) <- reads s3,+					(",",s4) <- lex r3,+					(x4, r4) <- reads s4,+					(",",s5) <- lex r4,+					(x5, r5) <- reads s5,+					(",",s6) <- lex r5,+					(x6, r6) <- reads s6,+					(",",s7) <- lex r6,+					(x7, r7) <- reads s7,+					(",",s8) <- lex r7,+					(x8, r8) <- reads s8,+					(",",s9) <- lex r8,+					(x9, r9) <- reads s9,+					(",",s10) <- lex r9,+					(x10, r10) <- reads s10,+					(",",s11) <- lex r10,+					(x11, r11) <- reads s11,+					(",",s12) <- lex r11,+					(x12, r12) <- reads s12,+					(",",s13) <- lex r12,+					(x13, r13) <- reads s13,+					(",",s14) <- lex r13,+					(x14, r14) <- reads s14,+					(",",s15) <- lex r14,+					(x15, r15) <- reads s15,+					(")",w)  <- lex r15 ] )+++instance  (Show a, Show b, Show c) => Show (a,b,c)  where+    showsPrec p (x,y,z) = showChar '(' . shows x . showString "," .+    	    	    	    	         shows y . showString "," .+					 shows z . showChar ')'++--     showsType  ~(x,y,z) = showChar '(' . showsType x . showChar ',' .+--     	    	    	    	         showsType y . showChar ',' .+-- 					 showsType z . showChar ')'++instance  (Show a, Show b, Show c, Show d) => Show (a,b,c,d)  where+    showsPrec p (x,y,z,u) = showChar '(' . shows x . showString "," .+    	    	    	    	           shows y . showString "," .+                                           shows z . showString "," .+					   shows u . showChar ')'++--     showsType  ~(x,y,z,u) = showChar '(' . showsType x . showChar ',' .+--     	    	    	    	           showsType y . showChar ',' .+-- 					   showsType z . showChar ',' .+-- 					   showsType u . showChar ')'++instance  (Show a, Show b, Show c, Show d, Show e) => Show (a,b,c,d,e)  where+    showsPrec p (x,y,z,u,v) = showChar '(' . shows x . showString "," .+    	    	    	    	           shows y . showString "," .+                                           shows z . showString "," .+					   shows u . showString "," .+					   shows v . showChar ')'++--     showsType  ~(x,y,z,u,v) = showChar '(' . showsType x . showChar ',' .+--     	    	    	    	           showsType y . showChar ',' .+-- 					   showsType z . showChar ',' .+-- 					   showsType u . showChar ',' .+-- 					   showsType v . showChar ')'++instance  (Show a, Show b, Show c, Show d, Show e, Show f) =>+	 Show (a,b,c,d,e,f)  where+    showsPrec p (x,y,z,u,v,w) = showChar '(' . shows x . showString "," .+    	    	    	    	           shows y . showString "," .+                                           shows z . showString "," .+					   shows u . showString "," .+					   shows v . showString "," .+					   shows w . showChar ')'++--     showsType  ~(x,y,z,u,v,w) = showChar '(' . showsType x . showChar ',' .+--     	    	    	    	           showsType y . showChar ',' .+-- 					   showsType z . showChar ',' .+-- 					   showsType u . showChar ',' .+-- 					   showsType v . showChar ',' .+-- 					   showsType w . showChar ')'++instance  (Show a, Show b, Show c, Show d, Show e, Show f, Show g) =>+	 Show (a,b,c,d,e,f,g)  where+    showsPrec p (x,y,z,u,v,w,t) = showChar '(' . shows x . showString "," .+    	    	    	    	           shows y . showString "," .+                                           shows z . showString "," .+					   shows u . showString "," .+					   shows v . showString "," .+					   shows w . showString "," .+					   shows t . showChar ')'++--     showsType  ~(x,y,z,u,v,w,t) = showChar '(' . showsType x . showChar ',' .+--     	    	    	    	           showsType y . showChar ',' .+-- 					   showsType z . showChar ',' .+-- 					   showsType u . showChar ',' .+-- 					   showsType v . showChar ',' .+-- 					   showsType w . showChar ',' .+-- 					   showsType t . showChar ')'++instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g,+	  Show h) =>+	 Show (a,b,c,d,e,f,g,h)  where+    showsPrec p (x,y,z,u,v,w,t,a) = showChar '(' . shows x . showString "," .+    	    	    	    	           shows y . showString "," .+                                           shows z . showString "," .+					   shows u . showString "," .+					   shows v . showString "," .+					   shows w . showString "," .+					   shows t . showString "," .+					   shows a . showChar ')'++--     showsType  ~(x,y,z,u,v,w,t,a) = showChar '(' . showsType x . showChar ',' .+--     	    	    	    	           showsType y . showChar ',' .+-- 					   showsType z . showChar ',' .+-- 					   showsType u . showChar ',' .+-- 					   showsType v . showChar ',' .+-- 					   showsType w . showChar ',' .+-- 					   showsType t . showChar ',' .+-- 					   showsType a . showChar ')'++instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g,+	  Show h, Show i) =>+	 Show (a,b,c,d,e,f,g,h,i)  where+    showsPrec p (x,y,z,u,v,w,t,a,b) =+			 showChar '(' . shows x . showString "," .+    	    	    	    	           shows y . showString "," .+                                           shows z . showString "," .+					   shows u . showString "," .+					   shows v . showString "," .+					   shows w . showString "," .+					   shows t . showString "," .+					   shows a . showString "," .+					   shows b . showChar ')'++--     showsType  ~(x,y,z,u,v,w,t,a,b) =+-- 			 showChar '(' . showsType x . showChar ',' .+--     	    	    	    	           showsType y . showChar ',' .+-- 					   showsType z . showChar ',' .+-- 					   showsType u . showChar ',' .+-- 					   showsType v . showChar ',' .+-- 					   showsType w . showChar ',' .+-- 					   showsType t . showChar ',' .+-- 					   showsType a . showChar ',' .+-- 					   showsType b . showChar ')'++instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g,+	  Show h, Show i, Show j) =>+	 Show (a,b,c,d,e,f,g,h,i,j)  where+    showsPrec p (x,y,z,u,v,w,t,a,b,c) =+			 showChar '(' . shows x . showString "," .+    	    	    	    	           shows y . showString "," .+                                           shows z . showString "," .+					   shows u . showString "," .+					   shows v . showString "," .+					   shows w . showString "," .+					   shows t . showString "," .+					   shows a . showString "," .+					   shows b . showString "," .+					   shows c . showChar ')'++--     showsType  ~(x,y,z,u,v,w,t,a,b,c) =+-- 			 showChar '(' . showsType x . showChar ',' .+--     	    	    	    	           showsType y . showChar ',' .+-- 					   showsType z . showChar ',' .+-- 					   showsType u . showChar ',' .+-- 					   showsType v . showChar ',' .+-- 					   showsType w . showChar ',' .+-- 					   showsType t . showChar ',' .+-- 					   showsType a . showChar ',' .+-- 					   showsType b . showChar ',' .+-- 					   showsType c . showChar ')'++instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g,+	  Show h, Show i, Show j, Show k) =>+	 Show (a,b,c,d,e,f,g,h,i,j,k)  where+    showsPrec p (x,y,z,u,v,w,t,a,b,c,d) =+			 showChar '(' . shows x . showString "," .+    	    	    	    	           shows y . showString "," .+                                           shows z . showString "," .+					   shows u . showString "," .+					   shows v . showString "," .+					   shows w . showString "," .+					   shows t . showString "," .+					   shows a . showString "," .+					   shows b . showString "," .+					   shows c . showString "," .+					   shows d . showChar ')'++--     showsType  ~(x,y,z,u,v,w,t,a,b,c,d) =+-- 			 showChar '(' . showsType x . showChar ',' .+--     	    	    	    	           showsType y . showChar ',' .+-- 					   showsType z . showChar ',' .+-- 					   showsType u . showChar ',' .+-- 					   showsType v . showChar ',' .+-- 					   showsType w . showChar ',' .+-- 					   showsType t . showChar ',' .+-- 					   showsType a . showChar ',' .+-- 					   showsType b . showChar ',' .+-- 					   showsType c . showChar ',' .+-- 					   showsType d . showChar ')'++instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g,+	  Show h, Show i, Show j, Show k, Show l) =>+	 Show (a,b,c,d,e,f,g,h,i,j,k,l)  where+    showsPrec p (x,y,z,u,v,w,t,a,b,c,d,e) =+			 showChar '(' . shows x . showString "," .+    	    	    	    	           shows y . showString "," .+                                           shows z . showString "," .+					   shows u . showString "," .+					   shows v . showString "," .+					   shows w . showString "," .+					   shows t . showString "," .+					   shows a . showString "," .+					   shows b . showString "," .+					   shows c . showString "," .+					   shows d . showString "," .+					   shows e . showChar ')'++--     showsType  ~(x,y,z,u,v,w,t,a,b,c,d,e) =+-- 			 showChar '(' . showsType x . showChar ',' .+--     	    	    	    	           showsType y . showChar ',' .+-- 					   showsType z . showChar ',' .+-- 					   showsType u . showChar ',' .+-- 					   showsType v . showChar ',' .+-- 					   showsType w . showChar ',' .+-- 					   showsType t . showChar ',' .+-- 					   showsType a . showChar ',' .+-- 					   showsType b . showChar ',' .+-- 					   showsType c . showChar ',' .+-- 					   showsType d . showChar ',' .+-- 					   showsType e . showChar ')'++instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g,+	  Show h, Show i, Show j, Show k, Show l, Show m) =>+	 Show (a,b,c,d,e,f,g,h,i,j,k,l,m)  where+    showsPrec p (x,y,z,u,v,w,t,a,b,c,d,e,f) =+			 showChar '(' . shows x . showString "," .+    	    	    	    	           shows y . showString "," .+                                           shows z . showString "," .+					   shows u . showString "," .+					   shows v . showString "," .+					   shows w . showString "," .+					   shows t . showString "," .+					   shows a . showString "," .+					   shows b . showString "," .+					   shows c . showString "," .+					   shows d . showString "," .+					   shows e . showString "," .+					   shows f . showChar ')'++--     showsType  ~(x,y,z,u,v,w,t,a,b,c,d,e,f) =+-- 			 showChar '(' . showsType x . showChar ',' .+--     	    	    	    	           showsType y . showChar ',' .+-- 					   showsType z . showChar ',' .+-- 					   showsType u . showChar ',' .+-- 					   showsType v . showChar ',' .+-- 					   showsType w . showChar ',' .+-- 					   showsType t . showChar ',' .+-- 					   showsType a . showChar ',' .+-- 					   showsType b . showChar ',' .+-- 					   showsType c . showChar ',' .+-- 					   showsType d . showChar ',' .+-- 					   showsType e . showChar ',' .+-- 					   showsType f . showChar ')'++instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g,+	  Show h, Show i, Show j, Show k, Show l, Show m, Show n) =>+	 Show (a,b,c,d,e,f,g,h,i,j,k,l,m,n)  where+    showsPrec p (x,y,z,u,v,w,t,a,b,c,d,e,f,g) =+			 showChar '(' . shows x . showString "," .+    	    	    	    	           shows y . showString "," .+                                           shows z . showString "," .+					   shows u . showString "," .+					   shows v . showString "," .+					   shows w . showString "," .+					   shows t . showString "," .+					   shows a . showString "," .+					   shows b . showString "," .+					   shows c . showString "," .+					   shows d . showString "," .+					   shows e . showString "," .+					   shows f . showString "," .+					   shows g . showChar ')'++--     showsType  ~(x,y,z,u,v,w,t,a,b,c,d,e,f,g) =+-- 			 showChar '(' . showsType x . showChar ',' .+--     	    	    	    	           showsType y . showChar ',' .+-- 					   showsType z . showChar ',' .+-- 					   showsType u . showChar ',' .+-- 					   showsType v . showChar ',' .+-- 					   showsType w . showChar ',' .+-- 					   showsType t . showChar ',' .+-- 					   showsType a . showChar ',' .+-- 					   showsType b . showChar ',' .+-- 					   showsType c . showChar ',' .+-- 					   showsType d . showChar ',' .+-- 					   showsType e . showChar ',' .+-- 					   showsType f . showChar ',' .+-- 					   showsType g . showChar ')'++instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g,+	  Show h, Show i, Show j, Show k, Show l, Show m, Show n, Show o) =>+	 Show (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)  where+    showsPrec p (x,y,z,u,v,w,t,a,b,c,d,e,f,g,h) =+			 showChar '(' . shows x . showString "," .+    	    	    	    	           shows y . showString "," .+                                           shows z . showString "," .+					   shows u . showString "," .+					   shows v . showString "," .+					   shows w . showString "," .+					   shows t . showString "," .+					   shows a . showString "," .+					   shows b . showString "," .+					   shows c . showString "," .+					   shows d . showString "," .+					   shows e . showString "," .+					   shows f . showString "," .+					   shows g . showString "," .+					   shows h . showChar ')'++--     showsType  ~(x,y,z,u,v,w,t,a,b,c,d,e,f,g,h) =+-- 			 showChar '(' . showsType x . showChar ',' .+--     	    	    	    	           showsType y . showChar ',' .+-- 					   showsType z . showChar ',' .+-- 					   showsType u . showChar ',' .+-- 					   showsType v . showChar ',' .+-- 					   showsType w . showChar ',' .+-- 					   showsType t . showChar ',' .+-- 					   showsType a . showChar ',' .+-- 					   showsType b . showChar ',' .+-- 					   showsType c . showChar ',' .+-- 					   showsType d . showChar ',' .+-- 					   showsType e . showChar ',' .+-- 					   showsType f . showChar ',' .+-- 					   showsType g . showChar ',' .+-- 					   showsType h . showChar ')'+++-- A.3  Prelude PreludeIO+-- module PreludeIO (+--    FilePath, IOError, ioError, userError, catch,+--    putChar, putStr, putStrLn, print,+--    getChar, getLine, getContents, interact,+--    readFile, writeFile, appendFile, readIO, readLn+--  ) where+++type  FilePath = String+++-- data IOError    -- The internals of this type are system dependent++{- not needed, because IOError = Prelude.IOError and instance available from Prelude+instance  Show IOError where+  show = primIOErrorShow+-}++{- currently excluded because instance Eq IOError missing in ghc 5.02+instance  Eq IOError  where +  (==) = primIOErrorEq+-}++-- ioError          ::  IOError -> IO a +-- ioError          =   primIOError++-- userError        ::  String -> IOError+-- userError        =   primUserError++-- catch            ::  IO a -> (IOError -> IO a) -> IO a +-- catch            =   primCatch++-- putChar          :: Char -> IO ()+-- putChar          =  primPutChar++putStr           :: String -> IO ()+putStr s         =  mapM_ putChar s++putStrLn         :: String -> IO ()+putStrLn s       =  do putStr s+                       putStr "\n"++print            :: Show a => a -> IO ()+print x          =  putStrLn (show x)++-- getChar          :: IO Char+-- getChar          =  primGetChar++getLine          :: IO String+getLine          =  do c <- getChar+                       if c == '\n' then return "" else +                          do s <- getLine+                             return (c:s)+            +-- getContents      :: IO String+-- getContents      =  primGetContents++interact         ::  (String -> String) -> IO ()+interact f       =  do s <- getContents+                       putStr (f s)++-- readFile         :: FilePath -> IO String+-- readFile         =  primReadFile++-- writeFile        :: FilePath -> String -> IO ()+-- writeFile        =  primWriteFile++-- appendFile       :: FilePath -> String -> IO ()+-- appendFile       =  primAppendFile++  -- raises an exception instead of an error++readIO   :: Read a => String -> IO a+readIO s =  case [x | (x,t) <- reads s, ("","") <- lex t] of+              [x] -> return x+              []  -> ioError (userError "Prelude.readIO: no parse")+              _   -> ioError (userError "Prelude.readIO: ambiguous parse")+++readLn           :: Read a => IO a+readLn           =  do l <- getLine+                       r <- readIO l+                       return r+++++-- import Char(isSpace, isAlpha, isDigit, isAlphaNum,+--            showLitChar, readLitChar, lexLitChar)++-- module Char ( +--    isAscii, isLatin1, isControl, isPrint, isSpace, isUpper, isLower,+--    isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum,+--    digitToInt, intToDigit,+--    toUpper, toLower,+--    ord, chr,+--    readLitChar, showLitChar, lexLitChar,+--+-- ...and what the Prelude exports+--    Char, String+--    ) where++-- import Array  -- used for character name table.+++-- Digit conversion operations+digitToInt :: Char -> Int+digitToInt c+  | isDigit c            =  fromEnum c - fromEnum '0'+  | c >= 'a' && c <= 'f' =  fromEnum c - fromEnum 'a' + 10+  | c >= 'A' && c <= 'F' =  fromEnum c - fromEnum 'A' + 10+  | otherwise            =  error "Char.digitToInt: not a digit"++intToDigit :: Int -> Char+intToDigit i+  | i >= 0  && i <=  9   =  toEnum (fromEnum '0' + i)+  | i >= 10 && i <= 15   =  toEnum (fromEnum 'a' + i - 10)+  | otherwise            =  error "Char.intToDigit: not a digit"++++-- Character code functions+ord                     :: Char -> Int+ord                     =  fromEnum++chr                     :: Int  -> Char+chr                     =  toEnum++-- Text functions+readLitChar             :: ReadS Char+readLitChar ('\\':s)    =  readEsc s+        where+        readEsc ('a':s)  = [('\a',s)]+        readEsc ('b':s)  = [('\b',s)]+        readEsc ('f':s)  = [('\f',s)]+        readEsc ('n':s)  = [('\n',s)]+        readEsc ('r':s)  = [('\r',s)]+        readEsc ('t':s)  = [('\t',s)]+        readEsc ('v':s)  = [('\v',s)]+        readEsc ('\\':s) = [('\\',s)]+        readEsc ('"':s)  = [('"',s)]+        readEsc ('\'':s) = [('\'',s)]+        readEsc ('^':c:s) | c >= '@' && c <= '_'+                         = [(chr (ord c - ord '@'), s)]+        readEsc s@(d:_) | isDigit d+                         = [(chr n, t) | (n,t) <- readDec s]+        readEsc ('o':s)  = [(chr n, t) | (n,t) <- readOct s]+        readEsc ('x':s)  = [(chr n, t) | (n,t) <- readHex s]+        readEsc s@(c:_) | isUpper c+                         = let table = ('\DEL', "DEL") : {- assocs -} asciiTab+                           in case [(c,s') | (c, mne) <- table,+                                             ([],s') <- [match mne s]]+                              of (pr:_) -> [pr]+                                 []     -> []+        readEsc _        = []++        match                         :: (Eq a) => [a] -> [a] -> ([a],[a])+        match (x:xs) (y:ys) | x == y  =  match xs ys+        match xs     ys               =  (xs,ys)+readLitChar (c:s)       =  [(c,s)]++showLitChar               :: Char -> ShowS+showLitChar c | c > '\DEL' =  showChar '\\' . +                              protectEsc isDigit (shows (ord c))+showLitChar '\DEL'         =  showString "\\DEL"+showLitChar '\\'           =  showString "\\\\"+showLitChar c | c >= ' '   =  showChar c+showLitChar '\a'           =  showString "\\a"+showLitChar '\b'           =  showString "\\b"+showLitChar '\f'           =  showString "\\f"+showLitChar '\n'           =  showString "\\n"+showLitChar '\r'           =  showString "\\r"+showLitChar '\t'           =  showString "\\t"+showLitChar '\v'           =  showString "\\v"+showLitChar '\SO'          =  protectEsc (== 'H') (showString "\\SO")+showLitChar c              =  showString ('\\' : snd (asciiTab !! ord c){-!c-})++protectEsc p f             = f . cont+                             where cont s@(c:_) | p c = "\\&" ++ s+                                   cont s             = s+asciiTab = {- listArray ('\NUL', ' ') -}+           zip ['\NUL'..' ']+           ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",+            "BS",  "HT",  "LF",  "VT",  "FF",  "CR",  "SO",  "SI", +            "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",+            "CAN", "EM",  "SUB", "ESC", "FS",  "GS",  "RS",  "US", +            "SP"] ++lexLitChar          :: ReadS String+lexLitChar ('\\':s) =  [('\\':esc, t) | (esc,t) <- lexEsc s]+        where+          lexEsc (c:s)     | c `elem` "abfnrtv\\\"'" = [([c],s)]+          lexEsc s@(d:_)   | isDigit d               = lexDigits s+          lexEsc ('^':c:s) | c >= '@' && c <= '_'    = [(['^',c],s)]+          -- Very crude approximation to \XYZ.  Let readers work this out.+          lexEsc s@(c:_)   | isUpper c               = [span isCharName s]+          lexEsc _                                   = []+          isCharName c = isUpper c || isDigit c++lexLitChar (c:s)    =  [([c],s)]+lexLitChar ""       =  []+++-- import Numeric(showSigned, showInt, readSigned, readDec, showFloat,+--               readFloat, lexDigits)+-- import Numeric (readDec, readOct, lexDigits, readHex)++-- module Numeric(fromRat,+--               showSigned, showInt,+--               readSigned, readInt,+--               readDec, readOct, readHex, +--               floatToDigits,+--               showEFloat, showFFloat, showGFloat, showFloat, +--               readFloat, lexDigits) where++-- import Ratio  ( (%), numerator, denominator )+-- import Array  ( (!), Array, array )++-- This converts a rational to a floating.  This should be used in the+-- Fractional instances of Float and Double.++fromRat :: (RealFloat a) => Rational -> a+fromRat x = +    if x == 0 then encodeFloat 0 0              -- Handle exceptional cases+    else if x < 0 then - fromRat' (-x)          -- first.+    else fromRat' x++-- Conversion process:+-- Scale the rational number by the RealFloat base until+-- it lies in the range of the mantissa (as used by decodeFloat/encodeFloat).+-- Then round the rational to an Integer and encode it with the exponent+-- that we got from the scaling.+-- To speed up the scaling process we compute the log2 of the number to get+-- a first guess of the exponent.+fromRat' :: (RealFloat a) => Rational -> a+fromRat' x = r+  where b = floatRadix r+        p = floatDigits r+        (minExp0, _) = floatRange r+        minExp = minExp0 - p            -- the real minimum exponent+        xMin = toRational (expt b (p-1))+        xMax = toRational (expt b p)+        p0 = (integerLogBase b (numerator x) -+              integerLogBase b (denominator x) - p) `max` minExp+        f = if p0 < 0 then 1 % expt b (-p0) else expt b p0 % 1+        (x', p') = scaleRat (toRational b) minExp xMin xMax p0 (x / f)+        r = encodeFloat (round x') p'++-- Scale x until xMin <= x < xMax, or p (the exponent) <= minExp.+scaleRat :: Rational -> Int -> Rational -> Rational -> +             Int -> Rational -> (Rational, Int)+scaleRat b minExp xMin xMax p x =+    if p <= minExp then+        (x, p)+    else if x >= xMax then+        scaleRat b minExp xMin xMax (p+1) (x/b)+    else if x < xMin  then+        scaleRat b minExp xMin xMax (p-1) (x*b)+    else+        (x, p)++-- Exponentiation with a cache for the most common numbers.+minExpt = 0::Int+maxExpt = 1100::Int+expt :: Integer -> Int -> Integer+expt base n =+    if base == 2 && n >= minExpt && n <= maxExpt then+        expts {-!n-} !! (n-minExpt)+    else+        base^n++expts :: {- Array Int Integer -} [Integer]+expts = [2^n | n <- [minExpt .. maxExpt]]+        {- array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]] -}++-- Compute the (floor of the) log of i in base b.+-- Simplest way would be just divide i by b until it's smaller then b,+-- but that would be very slow!  We are just slightly more clever.+integerLogBase :: Integer -> Integer -> Int+integerLogBase b i =+     if i < b then+        0+     else+        -- Try squaring the base first to cut down the number of divisions.+        let l = 2 * integerLogBase (b*b) i+            doDiv :: Integer -> Int -> Int+            doDiv i l = if i < b then l else doDiv (i `div` b) (l+1)+        in  doDiv (i `div` (b^l)) l+++-- Misc utilities to show integers and floats ++showSigned    :: Real a => (a -> ShowS) -> Int -> a -> ShowS+showSigned showPos p x | x < 0 = showParen (p > 6)+                                           (showChar '-' . showPos (-x))+                       | otherwise = showPos x++-- showInt, showOct, showHex are used for positive numbers only+showInt, showOct, showHex :: Integral a => a -> ShowS+showOct = showIntAtBase  8 intToDigit+showInt = showIntAtBase 10 intToDigit+showHex = showIntAtBase 16 intToDigit++showIntAtBase :: Integral a +      => a              -- base+      -> (Int -> Char)  -- digit to char+      -> a              -- number to show+      -> ShowS+showIntAtBase base intToDig n rest+  | n < 0     = error "Numeric.showIntAtBase: can't show negative numbers"+  | n' == 0   = rest'+  | otherwise = showIntAtBase base intToDig n' rest'+  where+    (n',d) = quotRem n base+    rest'  = intToDig (fromIntegral d) : rest++readSigned :: (Real a) => ReadS a -> ReadS a+readSigned readPos = readParen False read'+                     where read' r  = read'' r +++                                      [(-x,t) | ("-",s) <- lex r,+                                                (x,t)   <- read'' s]+                           read'' r = [(n,s)  | (str,s) <- lex r,+                                                (n,"")  <- readPos str]+++-- readInt reads a string of digits using an arbitrary base.  +-- Leading minus signs must be handled elsewhere.++readInt :: (Integral a) => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a+readInt radix isDig digToInt s =+   [(foldl1 (\n d -> n * radix + d) (map (fromIntegral . digToInt) ds), r)+   | (ds,r) <- nonnull isDig s ]++-- Unsigned readers for various bases+readDec, readOct, readHex :: (Integral a) => ReadS a+readDec = readInt 10 isDigit    digitToInt+readOct = readInt  8 isOctDigit digitToInt+readHex = readInt 16 isHexDigit digitToInt+++showEFloat     :: (RealFloat a) => Maybe Int -> a -> ShowS+showFFloat     :: (RealFloat a) => Maybe Int -> a -> ShowS+showGFloat     :: (RealFloat a) => Maybe Int -> a -> ShowS+showFloat      :: (RealFloat a) => a -> ShowS++showEFloat d x =  showString (formatRealFloat FFExponent d x)+showFFloat d x =  showString (formatRealFloat FFFixed d x)+showGFloat d x =  showString (formatRealFloat FFGeneric d x)+showFloat      =  showGFloat Nothing ++-- These are the format types.  This type is not exported.++data FFFormat = FFExponent | FFFixed | FFGeneric++formatRealFloat :: (RealFloat a) => FFFormat -> Maybe Int -> a -> String+formatRealFloat fmt decs x +  = s+  where +    base = 10+    s = if isNaN x then +            "NaN"+        else if isInfinite x then +            if x < 0 then "-Infinity" else "Infinity"+        else if x < 0 || isNegativeZero x then +            '-' : doFmt fmt (floatToDigits (toInteger base) (-x))+        else +            doFmt fmt (floatToDigits (toInteger base) x)+    +    doFmt fmt (is, e)+      = let +           ds = map intToDigit is+        in  +        case fmt of+          FFGeneric -> +              doFmt (if e < 0 || e > 7 then FFExponent else FFFixed)+                    (is, e)+          FFExponent ->+            case decs of+              Nothing ->+                case ds of+                   []    -> "0.0e0"+                   [d]   -> d : ".0e" ++ show (e-1)+                   d:ds  -> d : '.' : ds ++ 'e':show (e-1)+          +              Just dec ->+                let dec' = max dec 1 in+                case is of+                  [] -> '0':'.':take dec' (repeat '0') ++ "e0"+                  _ ->+                    let (ei, is') = roundTo base (dec'+1) is+                        d:ds = map intToDigit+                                   (if ei > 0 then init is' else is')+                    in d:'.':ds  ++ "e" ++ show (e-1+ei)+          +          FFFixed ->+            case decs of+               Nothing  -- Always prints a decimal point+                 | e > 0     -> take e (ds ++ repeat '0')+                                ++ '.' : mk0 (drop e ds)+                 | otherwise -> "0." ++ mk0 (replicate (-e) '0' ++ ds)+              +               Just dec ->  -- Print decimal point iff dec > 0+                 let dec' = max dec 0 in+                 if e >= 0 then+                   let (ei, is') = roundTo base (dec' + e) is+                       (ls, rs)  = splitAt (e+ei) +                                              (map intToDigit is')+                   in  mk0 ls ++ mkdot0 rs+                 else+                   let (ei, is') = roundTo base dec' +                                           (replicate (-e) 0 ++ is)+                       d : ds = map intToDigit +                                    (if ei > 0 then is' else 0:is')+                   in  d : mkdot0 ds+            where   +              mk0 "" = "0"        -- Print 0.34, not .34+              mk0 s  = s  +    +              mkdot0 "" = ""       -- Print 34, not 34.+              mkdot0 s  = '.' : s  -- when the format specifies no+           -- digits after the decimal point+    ++roundTo :: Int -> Int -> [Int] -> (Int, [Int])+roundTo base d is = case f d is of+                (0, is) -> (0, is)+                (1, is) -> (1, 1 : is)+  where b2 = base `div` 2+        f n [] = (0, replicate n 0)+        f 0 (i:_) = (if i >= b2 then 1 else 0, [])+        f d (i:is) = +            let (c, ds) = f (d-1) is+                i' = c + i+            in  if i' == base then (1, 0:ds) else (0, i':ds)++--+-- Based on "Printing Floating-Point Numbers Quickly and Accurately"+-- by R.G. Burger and R. K. Dybvig, in PLDI 96.+-- The version here uses a much slower logarithm estimator.  +-- It should be improved.++-- This function returns a non-empty list of digits (Ints in [0..base-1])+-- and an exponent.  In general, if+--      floatToDigits r = ([a, b, ... z], e)+-- then+--      r = 0.ab..z * base^e+-- ++floatToDigits :: (RealFloat a) => Integer -> a -> ([Int], Int)++floatToDigits _ 0 = ([], 0)+floatToDigits base x =+    let (f0, e0) = decodeFloat x+        (minExp0, _) = floatRange x+        p = floatDigits x+        b = floatRadix x+        minExp = minExp0 - p            -- the real minimum exponent++        -- Haskell requires that f be adjusted so denormalized numbers+        -- will have an impossibly low exponent.  Adjust for this.+        f :: Integer+        e :: Int+        (f, e) = let n = minExp - e0+                 in  if n > 0 then (f0 `div` (b^n), e0+n) else (f0, e0)++        (r, s, mUp, mDn) =+           if e >= 0 then+               let be = b^e in+               if f == b^(p-1) then+                   (f*be*b*2, 2*b, be*b, b)+               else+                   (f*be*2, 2, be, be)+           else+               if e > minExp && f == b^(p-1) then+                   (f*b*2, b^(-e+1)*2, b, 1)+               else+                   (f*2, b^(-e)*2, 1, 1)+        k = +            let k0 =+                    if b==2 && base==10 then+                        -- logBase 10 2 is slightly bigger than 3/10 so+                        -- the following will err on the low side.  Ignoring+                        -- the fraction will make it err even more.+                        -- Haskell promises that p-1 <= logBase b f < p.+                        (p - 1 + e0) * 3 `div` 10+                    else+                        ceiling (((log (fromInteger (f+1)) + +                                 fromIntegral e * log (fromInteger b)) / +                                  log (fromInteger base)) +                                 :: Double {-DEFAULT-})+                fixup n =+                    if n >= 0 then+                        if r + mUp <= expt base n * s then n else fixup (n+1)+                    else+                        if expt base (-n) * (r + mUp) <= s then n+                                                           else fixup (n+1)+            in  fixup k0++        gen ds rn sN mUpN mDnN =+            let (dn, rn') = (rn * base) `divMod` sN+                mUpN' = mUpN * base+                mDnN' = mDnN * base+            in  case (rn' < mDnN', rn' + mUpN' > sN) of+                (True,  False) -> dn : ds+                (False, True)  -> dn+1 : ds+                (True,  True)  -> if rn' * 2 < sN then dn : ds else dn+1 : ds+                (False, False) -> gen (dn:ds) rn' sN mUpN' mDnN'+        rds =+            if k >= 0 then+                gen [] r (s * expt base k) mUp mDn+            else+                let bk = expt base (-k)+                in  gen [] (r * bk) s (mUp * bk) (mDn * bk)+    in  (map fromIntegral (reverse rds), k)++++-- This floating point reader uses a less restrictive syntax for floating+-- point than the Haskell lexer.  The `.' is optional.++readFloat     :: (RealFloat a) => ReadS a+readFloat r    = [(fromRational ((n%1)*10^^(k-d)),t) | (n,d,s) <- readFix r,+                                                       (k,t)   <- readExp s] +++                 [ (0/0, t) | ("NaN",t)      <- lex r] +++                 [ (1/0, t) | ("Infinity",t) <- lex r]+               where +                 readFix r = [(read (ds++ds'), length ds', t)+                             | (ds,d) <- lexDigits r,+                               (ds',t) <- lexFrac d ]+               +                 lexFrac ('.':ds) = lexDigits ds+                 lexFrac s        = [("",s)]        +                 +                 readExp (e:s) | e `elem` "eE" = readExp' s+                 readExp s                     = [(0,s)]+                 +                 readExp' ('-':s) = [(-k,t) | (k,t) <- readDec s]+                 readExp' ('+':s) = readDec s+                 readExp' s       = readDec s++lexDigits        :: ReadS String +lexDigits        =  nonnull isDigit++nonnull          :: (Char -> Bool) -> ReadS String+nonnull p s      =  [(cs,t) | (cs@(_:_),t) <- [span p s]]+++-- module  Ratio (+--    Ratio, Rational, (%), numerator, denominator, approxRational ) where++infixl 7  %++prec = 7 :: Int++data  Ratio a = !a :% !a  deriving (Eq)  -- no class Integral a class context in 2010+type  Rational          =  Ratio Integer+++(%)                     :: (Integral a) => a -> a -> Ratio a+numerator, denominator  :: (Integral a) => Ratio a -> a+approxRational          :: (RealFrac a) => a -> a -> Rational+++-- "reduce" is a subsidiary function used only in this module.+-- It normalises a ratio by dividing both numerator+-- and denominator by their greatest common divisor.+--+-- E.g., 12 `reduce` 8    ==  3 :%   2+--       12 `reduce` (-8) ==  3 :% (-2)++reduce _ 0              =  error "Ratio.% : zero denominator"+reduce x y              =  (x `quot` d) :% (y `quot` d)+                           where d = gcd x y++x % y                   =  reduce (x * signum y) (abs y)++numerator (x :% _)      =  x++denominator (_ :% y)    =  y+++instance  (Integral a)  => Ord (Ratio a)  where+    (x:%y) <= (x':%y')  =  x * y' <= x' * y+    (x:%y) <  (x':%y')  =  x * y' <  x' * y++instance  (Integral a)  => Num (Ratio a)  where+    (x:%y) + (x':%y')   =  reduce (x*y' + x'*y) (y*y')+    (x:%y) * (x':%y')   =  reduce (x * x') (y * y')+    negate (x:%y)       =  (-x) :% y+    abs (x:%y)          =  abs x :% y+    signum (x:%y)       =  signum x :% 1+    fromInteger x       =  fromInteger x :% 1++instance  (Integral a)  => Real (Ratio a)  where+    toRational (x:%y)   =  toInteger x :% toInteger y++instance  (Integral a)  => Fractional (Ratio a)  where+    (x:%y) / (x':%y')   =  (x*y') % (y*x')+    recip (x:%y)        =  y % x+    fromRational (x:%y) =  fromInteger x :% fromInteger y++instance  (Integral a)  => RealFrac (Ratio a)  where+    properFraction (x:%y) = (fromIntegral q, r:%y)+                            where (q,r) = quotRem x y++instance  (Integral a)  => Enum (Ratio a)  where+    toEnum           =  fromIntegral+    fromEnum         =  fromInteger . truncate -- May overflow+    enumFrom         =  numericEnumFrom     -- These numericEnumXXX functions+    enumFromThen     =  numericEnumFromThen -- are as defined in Prelude.hs+    enumFromTo       =  numericEnumFromTo   -- but not exported from it!+    enumFromThenTo   =  numericEnumFromThenTo++instance  (Read a, Integral a)  => Read (Ratio a)  where+    readsPrec p  =  readParen (p > prec)+                              (\r -> [(x%y,u) | (x,s)   <- reads r,+                                                ("%",t) <- lex s,+                                                (y,u)   <- reads t ])++instance  (Integral a)  => Show (Ratio a)  where+    showsPrec p (x:%y)  =  showParen (p > prec)+                               (shows x . showString " % " . shows y)++++approxRational x eps    =  simplest (x-eps) (x+eps)+        where simplest x y | y < x      =  simplest y x+                           | x == y     =  xr+                           | x > 0      =  simplest' n d n' d'+                           | y < 0      =  - simplest' (-n') d' (-n) d+                           | otherwise  =  0 :% 1+                                        where xr@(n:%d) = toRational x+                                              (n':%d')  = toRational y++              simplest' n d n' d'       -- assumes 0 < n%d < n'%d'+                        | r == 0     =  q :% 1+                        | q /= q'    =  (q+1) :% 1+                        | otherwise  =  (q*n''+d'') :% n''+                                     where (q,r)      =  quotRem n d+                                           (q',r')    =  quotRem n' d'+                                           (n'':%d'') =  simplest' d' r' d r+
+ libraries/PreludeBuiltin.hs view
@@ -0,0 +1,363 @@+-- Contains foreign haskell declarations for all functions+-- not (portably) definable in Haskell.+module PreludeBuiltin (+  -- reexport from module PreludeBuiltinTypes   +  (->),Bool(True,False),Char,Int,Integer,Float,Double,IOError +  ,[]((:),[]),IO+  ,()(())+  ,(,)((,)), (,,)((,,)),(,,,)((,,,)),(,,,,)((,,,,)),(,,,,,)((,,,,,))+  ,(,,,,,,)((,,,,,,)),(,,,,,,,)((,,,,,,,)),(,,,,,,,,)((,,,,,,,,))+  ,(,,,,,,,,,)((,,,,,,,,,)),(,,,,,,,,,,)((,,,,,,,,,,))+  ,(,,,,,,,,,,,)((,,,,,,,,,,,)),(,,,,,,,,,,,,)((,,,,,,,,,,,,))+  ,(,,,,,,,,,,,,,)((,,,,,,,,,,,,,)),(,,,,,,,,,,,,,,)((,,,,,,,,,,,,,,))+  ,String,error,undefined +  -- general (->) +  ,seq+  -- char +-- ,Char	-- already re-exported above+  ,isAscii,isLatin1,isControl,isPrint,isSpace,isUpper,isLower,isAlpha,isDigit+  ,isOctDigit,isHexDigit,isAlphaNum,toUpper,toLower+  ,primIntToChar,primCharToInt,primUnicodeMaxBound +  -- numeric+-- ,Int,Integer,Float,Double -- (,) 	-- already re-exported above+  ,primIntMinBound,primIntMaxBound+  ,primIntEq,primIntNe,primIntLt,primIntLe,primIntGt,primIntGe+  ,primIntQuot,primIntRem,primIntPlus,primIntMinus,primIntTimes+  ,primIntNegate,primIntAbs,primIntSignum,primIntegerFromInt+  ,primIntFromInteger,primIntegerEq,primIntegerNe,primIntegerLt+  ,primIntegerLe,primIntegerGt,primIntegerGe,primIntegerQuot+  ,primIntegerRem,primIntegerQuotRem ,primIntegerAdd+  ,primIntegerSub,primIntegerMul,primIntegerNeg+  ,primFloatFromInteger,primFloatRadix,primFloatDigits,primFloatRange+  ,primDecodeFloat,primEncodeFloat,primFloatIsNaN,primFloatIsInfinite+  ,primFloatIsDenormalized,primFloatIsNegativeZero,primFloatIsIEEE+  ,primFloatEq,primFloatNe,primFloatLt,primFloatLe,primFloatGt+  ,primFloatGe,primFloatPi,primFloatExp,primFloatLog,primFloatSqrt+  ,primFloatSin,primFloatCos,primFloatTan,primFloatAsin+  ,primFloatAcos,primFloatAtan,primFloatDiv,primFloatAdd+  ,primFloatSub,primFloatMul,primFloatAbs,primFloatSignum+  ,primDoubleFromInteger,primDoubleRadix,primDoubleDigits,primDoubleRange+  ,primDecodeDouble,primEncodeDouble,primDoubleIsNaN,primDoubleIsInfinite+  ,primDoubleIsDenormalized,primDoubleIsNegativeZero,primDoubleIsIEEE+  ,primDoubleEq,primDoubleNe,primDoubleLt,primDoubleLe+  ,primDoubleGt,primDoubleGe,primDoublePi,primDoubleExp,primDoubleLog+  ,primDoubleSqrt,primDoubleSin,primDoubleCos,primDoubleTan+  ,primDoubleAsin,primDoubleAcos,primDoubleAtan,primDoubleDiv+  ,primDoubleAdd,primDoubleSub,primDoubleMul,primDoubleAbs+  ,primDoubleSignum +  -- IO +-- ,IO,IOError -- ()	-- already re-exported above+  ,primIOBind,primIOReturn+  ,ioError,userError,catch,putChar,getChar,getContents,readFile,writeFile+  ,appendFile,primIOErrorShow{- ,primIOErrorEq -} +  ) where++import PreludeBuiltinTypes+import TraceOrigHat.Hat  -- for some primitive types+import qualified TraceOrigPrelude  -- not to be transformed+import qualified TraceOrigData.Char as TraceOrigChar  -- not to be transformed++-- types appearing here+-- (->), String, Char, Bool, Int, Integer, Float, Double, (,), IO, IOError, ()++-- general:++infixr 0 `seq`++foreign import haskell "Prelude.seq"+  seq :: a -> b -> b++foreign import haskell "Char.isAscii"+  isAscii :: Char -> Bool+foreign import haskell "Char.isLatin1"+  isLatin1 :: Char -> Bool+foreign import haskell "Char.isControl"+  isControl :: Char -> Bool+foreign import haskell "Char.isPrint"+  isPrint :: Char -> Bool+foreign import haskell "Char.isSpace"+  isSpace :: Char -> Bool+foreign import haskell "Char.isUpper"+  isUpper :: Char -> Bool+foreign import haskell "Char.isLower"+  isLower :: Char -> Bool+foreign import haskell "Char.isAlpha"+  isAlpha :: Char -> Bool+foreign import haskell "Char.isDigit"+  isDigit :: Char -> Bool+foreign import haskell "Char.isOctDigit"+  isOctDigit :: Char -> Bool+foreign import haskell "Char.isHexDigit"+  isHexDigit :: Char -> Bool+foreign import haskell "Char.isAlphaNum"+  isAlphaNum :: Char -> Bool++foreign import haskell "Char.toUpper"+  toUpper :: Char -> Char+foreign import haskell "Char.toLower"+  toLower :: Char -> Char++-- Character code functions+foreign import haskell "Char.ord"+  primCharToInt :: Char -> Int+foreign import haskell "Char.chr"+  primIntToChar :: Int  -> Char++foreign import haskell "Prelude.maxBound"+  primUnicodeMaxBound :: Char+++-- Numerics++-- system dependent+foreign import haskell "Prelude.minBound"+  primIntMinBound :: Int+foreign import haskell "Prelude.maxBound"+  primIntMaxBound :: Int++foreign import haskell "Prelude.=="+  primIntEq :: Int -> Int -> Bool+foreign import haskell "Prelude./="+  primIntNe :: Int -> Int -> Bool+foreign import haskell "Prelude.<"+  primIntLt :: Int -> Int -> Bool+foreign import haskell "Prelude.<="+  primIntLe :: Int -> Int -> Bool+foreign import haskell "Prelude.>"+  primIntGt :: Int -> Int -> Bool+foreign import haskell "Prelude.>="+  primIntGe :: Int -> Int -> Bool+foreign import haskell "Prelude.quot"+  primIntQuot   :: Int -> Int -> Int+foreign import haskell "Prelude.rem"+  primIntRem    :: Int -> Int -> Int+foreign import haskell "Prelude.+"+  primIntPlus   :: Int -> Int -> Int+foreign import haskell "Prelude.-"+  primIntMinus  :: Int -> Int -> Int+foreign import haskell "Prelude.*"+  primIntTimes  :: Int -> Int -> Int+foreign import haskell "Prelude.negate"+  primIntNegate :: Int -> Int+foreign import haskell "Prelude.abs"+  primIntAbs    :: Int -> Int+foreign import haskell "Prelude.signum"+  primIntSignum :: Int -> Int++foreign import haskell "Prelude.toInteger"+  primIntegerFromInt :: Int -> Integer+foreign import haskell "Prelude.fromInteger"+  primIntFromInteger :: Integer -> Int++foreign import haskell "Prelude.=="+  primIntegerEq :: Integer -> Integer -> Bool+foreign import haskell "Prelude./="+  primIntegerNe :: Integer -> Integer -> Bool+foreign import haskell "Prelude.<"+  primIntegerLt :: Integer -> Integer -> Bool+foreign import haskell "Prelude.<="+  primIntegerLe :: Integer -> Integer -> Bool+foreign import haskell "Prelude.>"+  primIntegerGt :: Integer -> Integer -> Bool+foreign import haskell "Prelude.>="+  primIntegerGe :: Integer -> Integer -> Bool+foreign import haskell "Prelude.quot"+  primIntegerQuot    :: Integer -> Integer -> Integer+foreign import haskell "Prelude.rem"+  primIntegerRem     :: Integer -> Integer -> Integer+foreign import haskell "Prelude.quotRem"+  primIntegerQuotRem :: Integer -> Integer -> (Integer,Integer)+foreign import haskell "Prelude.+"+  primIntegerAdd     :: Integer -> Integer -> Integer+foreign import haskell "Prelude.-"+  primIntegerSub     :: Integer -> Integer -> Integer+foreign import haskell "Prelude.*"+  primIntegerMul     :: Integer -> Integer -> Integer+foreign import haskell "Prelude.negate"+  primIntegerNeg     :: Integer -> Integer++foreign import haskell "Prelude.fromInteger"+  primFloatFromInteger  :: Integer -> Float+foreign import haskell "Prelude.floatRadix"+  primFloatRadix        :: Float -> Integer+foreign import haskell "Prelude.floatDigits"+  primFloatDigits       :: Float -> Int+foreign import haskell "Prelude.floatRange"+  primFloatRange        :: Float -> (Int,Int) +foreign import haskell "Prelude.decodeFloat"+  primDecodeFloat       :: Float -> (Integer,Int)+foreign import haskell "Prelude.encodeFloat"+  primEncodeFloat       :: Integer -> Int -> Float+foreign import haskell "Prelude.isNaN"+  primFloatIsNaN   :: Float -> Bool+foreign import haskell "Prelude.isInfinite"+  primFloatIsInfinite   :: Float -> Bool+foreign import haskell "Prelude.isDenormalized"+  primFloatIsDenormalized   :: Float -> Bool+foreign import haskell "Prelude.isNegativeZero"+  primFloatIsNegativeZero   :: Float -> Bool+foreign import haskell "Prelude.isIEEE"+  primFloatIsIEEE   :: Float -> Bool++foreign import haskell "Prelude.=="+  primFloatEq :: Float -> Float -> Bool+foreign import haskell "Prelude./="+  primFloatNe :: Float -> Float -> Bool+foreign import haskell "Prelude.<"+  primFloatLt :: Float -> Float -> Bool+foreign import haskell "Prelude.<="+  primFloatLe :: Float -> Float -> Bool+foreign import haskell "Prelude.>"+  primFloatGt :: Float -> Float -> Bool+foreign import haskell "Prelude.>="+  primFloatGe :: Float -> Float -> Bool+foreign import haskell "Prelude.pi"+  primFloatPi :: Float+foreign import haskell "Prelude.exp"+  primFloatExp  :: Float -> Float+foreign import haskell "Prelude.log"+  primFloatLog  :: Float -> Float+foreign import haskell "Prelude.sqrt"+  primFloatSqrt :: Float -> Float+foreign import haskell "Prelude.sin"+  primFloatSin  :: Float -> Float+foreign import haskell "Prelude.cos"+  primFloatCos  :: Float -> Float+foreign import haskell "Prelude.tan"+  primFloatTan  :: Float -> Float+foreign import haskell "Prelude.asin"+  primFloatAsin :: Float -> Float+foreign import haskell "Prelude.acos"+  primFloatAcos :: Float -> Float+foreign import haskell "Prelude.atan"+  primFloatAtan :: Float -> Float+foreign import haskell "Prelude./"+  primFloatDiv  :: Float -> Float -> Float+foreign import haskell "Prelude.+"+  primFloatAdd  :: Float -> Float -> Float+foreign import haskell "Prelude.-"+  primFloatSub  :: Float -> Float -> Float+foreign import haskell "Prelude.*"+  primFloatMul  :: Float -> Float -> Float+foreign import haskell "Prelude.abs"+  primFloatAbs    :: Float -> Float+foreign import haskell "Prelude.signum"+  primFloatSignum :: Float -> Float++foreign import haskell "Prelude.fromInteger"+  primDoubleFromInteger :: Integer -> Double+foreign import haskell "Prelude.floatRadix"+  primDoubleRadix   :: Double -> Integer+foreign import haskell "Prelude.floatDigits"+  primDoubleDigits  :: Double -> Int+foreign import haskell "Prelude.floatRange"+  primDoubleRange   :: Double -> (Int,Int)+foreign import haskell "Prelude.decodeFloat"+  primDecodeDouble :: Double -> (Integer,Int)+foreign import haskell "Prelude.encodeFloat"+  primEncodeDouble :: Integer -> Int -> Double+foreign import haskell "Prelude.isNaN"+  primDoubleIsNaN   :: Double -> Bool+foreign import haskell "Prelude.isInfinite"+  primDoubleIsInfinite   :: Double -> Bool+foreign import haskell "Prelude.isDenormalized"+  primDoubleIsDenormalized   :: Double -> Bool+foreign import haskell "Prelude.isNegativeZero"+  primDoubleIsNegativeZero   :: Double -> Bool+foreign import haskell "Prelude.isIEEE"+  primDoubleIsIEEE   :: Double -> Bool++foreign import haskell "Prelude.=="+  primDoubleEq :: Double -> Double -> Bool+foreign import haskell "Prelude./="+  primDoubleNe :: Double -> Double -> Bool+foreign import haskell "Prelude.<"+  primDoubleLt :: Double -> Double -> Bool+foreign import haskell "Prelude.<="+  primDoubleLe :: Double -> Double -> Bool+foreign import haskell "Prelude.>"+  primDoubleGt :: Double -> Double -> Bool+foreign import haskell "Prelude.>="+  primDoubleGe :: Double -> Double -> Bool+foreign import haskell "Prelude.pi"+  primDoublePi :: Double+foreign import haskell "Prelude.exp"+  primDoubleExp  :: Double -> Double+foreign import haskell "Prelude.log"+  primDoubleLog  :: Double -> Double+foreign import haskell "Prelude.sqrt"+  primDoubleSqrt :: Double -> Double+foreign import haskell "Prelude.sin"+  primDoubleSin  :: Double -> Double+foreign import haskell "Prelude.cos"+  primDoubleCos  :: Double -> Double+foreign import haskell "Prelude.tan"+  primDoubleTan  :: Double -> Double+foreign import haskell "Prelude.asin"+  primDoubleAsin :: Double -> Double+foreign import haskell "Prelude.acos"+  primDoubleAcos :: Double -> Double+foreign import haskell "Prelude.atan"+  primDoubleAtan :: Double -> Double+foreign import haskell "Prelude./"+  primDoubleDiv  :: Double -> Double -> Double+foreign import haskell "Prelude.+"+  primDoubleAdd  :: Double -> Double -> Double+foreign import haskell "Prelude.-"+  primDoubleSub  :: Double -> Double -> Double+foreign import haskell "Prelude.*"+  primDoubleMul  :: Double -> Double -> Double+foreign import haskell "Prelude.abs"+  primDoubleAbs    :: Double -> Double+foreign import haskell "Prelude.signum"+  primDoubleSignum :: Double -> Double+++-- IO++foreign import haskell "Prelude.>>="+  primIOBind :: IO a -> (a -> IO b) -> IO b+foreign import haskell "Prelude.return"+  primIOReturn :: a -> IO a+++foreign import haskell "Prelude.show"+  primIOErrorShow :: IOError -> String++{- currently excluded because instance Eq IOError missing in ghc 5.02+foreign import haskell "Prelude.=="+  primIOErrorEq :: IOError -> IOError -> Bool+-}+++foreign import haskell "Prelude.ioError"+  ioError ::  IOError -> IO a ++foreign import haskell "Prelude.userError"+  userError ::  String -> IOError++foreign import haskell "Prelude.catch"+  catch ::  IO a -> (IOError -> IO a) -> IO a ++-- foreign import haskell "Prelude.putChar"+--   putChar :: Char -> IO ()+-- HACK!+foreign import haskell +  "(\\_ c -> T.outputTrace kputChar [c] Prelude.>> Prelude.putChar c) Prelude.True"+  putChar :: Char -> IO ()++foreign import haskell "Prelude.getChar"+  getChar          :: IO Char++foreign import haskell "Prelude.getContents"+  getContents      :: IO String++foreign import haskell "Prelude.readFile"+  readFile         :: String -> IO String++foreign import haskell "(\\_ n s -> T.outputTrace kwriteFile s Prelude.>> Prelude.writeFile n s) Prelude.True"+  writeFile        :: String -> String -> IO ()++foreign import haskell "(\\_ n s -> T.outputTrace kappendFile s Prelude.>> Prelude.appendFile n s) Prelude.True"+  appendFile       :: String -> String -> IO ()+
+ libraries/Random.hs view
@@ -0,0 +1,165 @@+-- some parts are taken from the nhc98/Hugs implementation of Random+module Random (+  RandomGen(next, split, genRange),+  StdGen, mkStdGen,+  Random( random,   randomR, +  randoms,  randomRs,+  randomIO, randomRIO ),+  getStdRandom, getStdGen, setStdGen, newStdGen+  ) where++import PreludeBuiltinTypes+import RandomBuiltin+import qualified TraceOrigSystem.Random as TraceOrigRandom+import Char++---------------- The RandomGen class ------------------------++class RandomGen g where+  genRange :: g -> (Int, Int)+  next     :: g -> (Int, g)+  split    :: g -> (g, g)+   +  -- Default method+  genRange g = (minBound,maxBound)++---------------- A standard instance of RandomGen -----------++-- data StdGen = ... -- Abstract++instance RandomGen StdGen where+  genRange = primStdGenGenRange+  next = primStdGenNext+  split = primStdGenSplit++instance Read StdGen where+  readsPrec = primStdGenReadsPrec++instance Show StdGen where+  showsPrec = primStdGenShowsPrec++foreign import haskell "Random.genRange"+ primStdGenGenRange :: StdGen -> (Int,Int)+foreign import haskell "Random.next"+ primStdGenNext :: StdGen -> (Int,StdGen)+foreign import haskell "Random.split"+ primStdGenSplit :: StdGen -> (StdGen,StdGen)+foreign import haskell "Prelude.readsPrec"+ primStdGenReadsPrec :: Int -> String -> [(StdGen,String)]+foreign import haskell "Prelude.showsPrec"+ primStdGenShowsPrec :: Int -> StdGen -> String -> String+++foreign import haskell "Random.mkStdGen"+ mkStdGen :: Int -> StdGen++ ---------------- The Random class ---------------------------+class Random a where+  randomR :: RandomGen g => (a, a) -> g -> (a, g)+  random  :: RandomGen g => g -> (a, g)++  randomRs :: RandomGen g => (a, a) -> g -> [a]+  randoms  :: RandomGen g => g -> [a]++  randomRIO :: (a,a) -> IO a+  randomIO  :: IO a+     +  -- Default methods+  randoms g = x : randoms g' +    where +    (x,g') = random g+  randomRs range g = x : randomRs range g'+    where+    (x,g') = randomR range g+  randomIO        = getStdRandom random+  randomRIO range = getStdRandom (randomR range)++instance Random Int     where +  randomR (a,b) g = randomIvalInteger (toInteger a, toInteger b) g+  random g        = randomR (minBound,maxBound) g++instance Random Integer where +  randomR ival g = randomIvalInteger ival g+  random g	 = randomR (toInteger (minBound::Int), toInteger (maxBound::Int)) g++instance Random Float where+  random g        = randomIvalDouble (0::Double,1) realToFrac g+  randomR (a,b) g = randomIvalDouble (realToFrac a, realToFrac b) realToFrac g++instance Random Double  where +  randomR ival g = randomIvalDouble ival id g+  random g       = randomR (0::Double,1) g++instance Random Bool where +  randomR (a,b) g = +    case +      (randomIvalInteger (bool2Integer a, bool2Integer b) g) of+        (x, g) -> (int2Bool x, g)+    where+    bool2Integer :: Bool -> Integer+    bool2Integer False = 0+    bool2Integer True  = 1++    int2Bool :: Int -> Bool+    int2Bool 0	= False+    int2Bool _	= True++  random g = randomR (minBound,maxBound) g++instance Random Char where +  randomR (a,b) g = +      case (randomIvalInteger (toInteger (ord a), toInteger (ord b)) g) of+        (x,g) -> (chr x, g)+  random g = randomR (minBound,maxBound) g+++-- internal:+randomIvalInteger :: (RandomGen g, Num a) => (Integer, Integer) -> g -> (a, g)+randomIvalInteger (l,h) rng+ | l > h     = randomIvalInteger (h,l) rng+ | otherwise = case (f n 1 rng) of (v, rng') -> (fromInteger (l + v `mod` k), rng')+     where+       k = h - l + 1+       b = 2147483561+       n = iLogBase b k++       f 0 acc g = (acc, g)+       f n acc g = +          let+	   (x,g')   = next g+	  in+	  f (n-1) (fromInt x + acc * b) g'++randomIvalDouble :: (RandomGen g, Fractional a) => (Double, Double) -> (Double -> a) -> g -> (a, g)+randomIvalDouble (l,h) fromDouble rng +  | l > h     = randomIvalDouble (h,l) fromDouble rng+  | otherwise = +       case (randomIvalInteger (toInteger (minBound::Int), toInteger (maxBound::Int)) rng) of+         (x, rng') -> +	    let+	     scaled_x = +		fromDouble ((l+h)/2) + +                fromDouble ((h-l) / realToFrac intRange) *+		fromIntegral (x::Int)+	    in+	    (scaled_x, rng')++fromInt :: Num a => Int -> a+fromInt = fromInteger . toInteger++intRange :: Integer+intRange  = toInteger (maxBound::Int) - toInteger (minBound::Int)++iLogBase :: Integer -> Integer -> Integer+iLogBase b i = if i < b then 1 else 1 + iLogBase b (i `div` b)++---------------- The global random generator ----------------++foreign import haskell "Random.newStdGen"+ newStdGen    :: IO StdGen+foreign import haskell "Random.setStdGen"+ setStdGen    :: StdGen -> IO ()+foreign import haskell "Random.getStdGen"+ getStdGen    :: IO StdGen +foreign import haskell "Random.getStdRandom"+ getStdRandom :: (StdGen -> (a, StdGen)) -> IO a
+ libraries/Ratio.hs view
@@ -0,0 +1,7 @@+--  Wrapper that exports just the stuff normally defined in the +--  standard module Ratio. +module Ratio +  (Ratio, Rational, (%), numerator, denominator, approxRational) where++import PreludeBasic+
+ libraries/System.hs view
@@ -0,0 +1,24 @@+module System ( +     ExitCode(ExitSuccess,ExitFailure),+     getArgs, getProgName, getEnv, system, exitWith, exitFailure+   ) where++import PreludeBuiltinTypes+import SystemBuiltinTypes+import SystemBuiltin+import qualified TraceOrigSystem.Cmd as TraceOrigCmd+import qualified TraceOrigSystem.Environment as TraceOrigEnvironment+import qualified TraceOrigSystem.Exit as TraceOrigExit++foreign import haskell "Environment.getArgs"+ getArgs :: IO [String]+foreign import haskell "Environment.getProgName"+ getProgName :: IO String+foreign import haskell "Environment.getEnv"+ getEnv :: String -> IO String+foreign import haskell "Cmd.system"+ system :: String -> IO ExitCode+foreign import haskell "Exit.exitWith"+ exitWith :: ExitCode -> IO a+foreign import haskell "Exit.exitFailure"+ exitFailure :: IO a
+ libraries/SystemBuiltinTypes.hs view
@@ -0,0 +1,4 @@+module SystemBuiltinTypes where++data ExitCode = ExitSuccess | ExitFailure Int +                deriving (Eq, Ord, Read, Show)
+ libraries/Time.hs view
@@ -0,0 +1,132 @@+module Time (+        ClockTime, +        Month(January,February,March,April,May,June,+              July,August,September,October,November,December),+        Day(Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday),+        CalendarTime(CalendarTime, ctYear, ctMonth, ctDay, ctHour, ctMin,+                     ctSec, ctPicosec, ctWDay, ctYDay, ctTZName, ctTZ, ctIsDST),+        TimeDiff(TimeDiff, tdYear, tdMonth, tdDay, +                 tdHour, tdMin, tdSec, tdPicosec),+        getClockTime, addToClockTime, diffClockTimes,+        toCalendarTime, toUTCTime, toClockTime,+        calendarTimeToString, formatCalendarTime ) where+++import Ix(Ix)+import Locale(TimeLocale(TimeLocale,wDays,months,amPm,dateTimeFmt,dateFmt+                        ,timeFmt,time12Fmt)+             ,defaultTimeLocale)+import Char ( intToDigit )+import PreludeBuiltinTypes+import TimeBuiltinTypes+import TimeBuiltin+import qualified TraceOrigSystem.Time as TraceOrigTime++-- data ClockTime = ...                    -- Implementation-dependent++instance Ord  ClockTime where +  compare = primClockTimeCompare+  (<=) = primClockTimeLeEq++instance Eq   ClockTime where +  (==) = primClockTimeEqEq++foreign import haskell "Prelude.compare"+ primClockTimeCompare :: ClockTime -> ClockTime -> Ordering++foreign import haskell "Prelude.<="+ primClockTimeLeEq :: ClockTime -> ClockTime -> Bool++foreign import haskell "Prelude.=="+ primClockTimeEqEq :: ClockTime -> ClockTime -> Bool++foreign import haskell "Time.getClockTime"+ getClockTime            :: IO ClockTime++foreign import haskell "Time.addToClockTime"+ addToClockTime          :: TimeDiff     -> ClockTime -> ClockTime++foreign import haskell "Time.diffClockTimes"+ diffClockTimes          :: ClockTime    -> ClockTime -> TimeDiff++foreign import haskell "Time.toCalendarTime"+ toCalendarTime          :: ClockTime    -> IO CalendarTime++foreign import haskell "Time.toUTCTime"+ toUTCTime               :: ClockTime    -> CalendarTime++foreign import haskell "Time.toClockTime"+ toClockTime             :: CalendarTime -> ClockTime++foreign import haskell "Time.calendarTimeToString"+ calendarTimeToString    :: CalendarTime -> String++foreign import haskell "Time.formatCalendarTime"+ formatCalendarTime :: TimeLocale -> String -> CalendarTime -> String++{-+formatCalendarTime l fmt ct@(CalendarTime year mon day hour min sec sdec +                                           wday yday tzname _ _) =+        doFmt fmt+  where doFmt ('%':c:cs) = decode c ++ doFmt cs+        doFmt (c:cs) = c : doFmt cs+        doFmt "" = ""++        to12 :: Int -> Int+        to12 h = let h' = h `mod` 12 in if h' == 0 then 12 else h'++        decode 'A' = fst (wDays l  !! fromEnum wday)+        decode 'a' = snd (wDays l  !! fromEnum wday)+        decode 'B' = fst (months l !! fromEnum mon)+        decode 'b' = snd (months l !! fromEnum mon)+        decode 'h' = snd (months l !! fromEnum mon)+        decode 'C' = show2 (year `quot` 100)+        decode 'c' = doFmt (dateTimeFmt l)+        decode 'D' = doFmt "%m/%d/%y"+        decode 'd' = show2 day+        decode 'e' = show2' day+        decode 'H' = show2 hour+        decode 'I' = show2 (to12 hour)+        decode 'j' = show3 yday+        decode 'k' = show2' hour+        decode 'l' = show2' (to12 hour)+        decode 'M' = show2 min+        decode 'm' = show2 (fromEnum mon+1)+        decode 'n' = "\n"+        decode 'p' = (if hour < 12 then fst else snd) (amPm l)+        decode 'R' = doFmt "%H:%M"+        decode 'r' = doFmt (time12Fmt l)+        decode 'T' = doFmt "%H:%M:%S"+        decode 't' = "\t"+        decode 'S' = show2 sec+        decode 's' = ...                -- Implementation-dependent+        decode 'U' = show2 ((yday + 7 - fromEnum wday) `div` 7)+        decode 'u' = show (let n = fromEnum wday in +                           if n == 0 then 7 else n)+        decode 'V' = +            let (week, days) = +                   (yday + 7 - if fromEnum wday > 0 then +                               fromEnum wday - 1 else 6) `divMod` 7+            in  show2 (if days >= 4 then+                          week+1 +                       else if week == 0 then 53 else week)++        decode 'W' = +            show2 ((yday + 7 - if fromEnum wday > 0 then +                               fromEnum wday - 1 else 6) `div` 7)+        decode 'w' = show (fromEnum wday)+        decode 'X' = doFmt (timeFmt l)+        decode 'x' = doFmt (dateFmt l)+        decode 'Y' = show year+        decode 'y' = show2 (year `rem` 100)+        decode 'Z' = tzname+        decode '%' = "%"+        decode c   = [c]++show2, show2', show3 :: Int -> String+show2 x = [intToDigit (x `quot` 10), intToDigit (x `rem` 10)]++show2' x = if x < 10 then [ ' ', intToDigit x] else show2 x++show3 x = intToDigit (x `quot` 100) : show2 (x `rem` 100)+-}
+ libraries/TimeBuiltinTypes.hs view
@@ -0,0 +1,30 @@+module TimeBuiltinTypes where++import Ix(Ix(..))++data Month =  January   | February | March    | April+           |  May       | June     | July     | August+           |  September | October  | November | December+           deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show)++data Day   =  Sunday | Monday  | Tuesday  | Wednesday | Thursday +           |  Friday | Saturday+           deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show)++data CalendarTime = CalendarTime {+                ctYear                          :: Int,+                ctMonth                         :: Month,+                ctDay, ctHour, ctMin, ctSec     :: Int,+                ctPicosec                       :: Integer,+                ctWDay                          :: Day,+                ctYDay                          :: Int,+                ctTZName                        :: String,+                ctTZ                            :: Int,+                ctIsDST                         :: Bool+        } deriving (Eq, Ord, Read, Show)++data TimeDiff = TimeDiff {+                tdYear, tdMonth, tdDay, tdHour, tdMin, tdSec :: Int,+                tdPicosec                                    :: Integer+        } deriving (Eq, Ord, Read, Show)+
+ tools/ADT.hs view
@@ -0,0 +1,170 @@+module ADT (ADT(..),displayTree,displayTrees,trustIO,trustConstant+           ,trustModule,trustApps,foldHiddens,leaves,subADTs,detectCycles+           ,trustUnevaluated,(/==),trustMatchingFunction) where++import NodeExp    (NodeExp(..),fullEval,flatEval,(===),finalResult,isomorphicIn)+import SExp       (QName(..))+import Data.Maybe (isJust,fromJust)++data ADT = Branch [Int] NodeExp (Int -> String) [ADT]+         | Cycle [Int] [ADT]++instance Show ADT where+  show = displayTree 80 (\_ s -> s)++tag (Branch t _ _ _) = t+tag (Cycle t _) = t++instance Eq ADT where+  (Branch _ n _ _) == (Branch _ n' _ _) = n == n'+  (Cycle _ xs) == (Cycle _ xs') = xs == xs'+  _ == _ = False+  +instance Ord ADT where+  compare (Branch _ n _ _) (Branch _ n' _ _) = compare n n'+  compare (Branch _ _ _ _) (Cycle _ _) = GT+  compare (Cycle _ _) (Branch _ _ _ _) = LT+  compare (Cycle _ _) (Cycle _ _) = EQ++(/==) :: ADT -> ADT -> Bool+(/==) e1 e2 = tag e1 /= tag e2++detectCycles :: [ADT] -> [ADT]+detectCycles =+  map $ detCycles []+  where+    detCycles :: [ADT] -> ADT -> ADT+    detCycles previous x@(Branch t exp q chldr) =+      let found = findExp (flatEval fullEval exp) previous+      in case found of+           [] -> Branch t exp q $ map (detCycles (x:previous)) chldr+           d  -> Cycle t d++    findExp :: NodeExp -> [ADT] -> [ADT]+    findExp x l =+      filter ((x ===) . (flatEval fullEval) . (\(Branch _ e _ _) -> e)) l++-- | Displays an EDT using a provided formatting.+displayTree :: Int -> (NodeExp -> String -> String) -> ADT -> String+displayTree w a (Branch _ exp q ts) =+  (a exp $ q w) ++ "\n" ++ (concat $ otherQuestions (w - 2) a ts)+displayTree w a (Cycle t cs) =+  if isJust q && isJust e+    then "CYCLE!\n" ++ (a (fromJust e) $ (fromJust q) (w - 2)) +    else "CYCLE!\n"+  where+    (q,e) = findBranch cs+    findBranch [] = (Nothing,Nothing)+    findBranch (b@(Branch _ e n _):_) = (Just n,Just e)+    findBranch (_:xs) = findBranch xs++otherQuestions :: Int -> (NodeExp -> String -> String) -> [ADT] -> [String]+otherQuestions w a adts = +     zipWith prependTree bTrees prepends+  ++ zipWith prependTree wTree wPrepends+  where+    prepends = " | " : prepends+    wPrepends = "   " : wPrepends+    trees = map (displayTree (w - 3) a) adts+    (bTrees,wTree) = splitAt (length trees - 1) trees++prependTree text prepend = +  case theLines of+    []     -> "Error: An empty question was produced"+    (x:xs) -> unlines (  (" +-" ++ x) : (map (prepend ++) $ xs))+  where+    theLines = lines text++displayTrees :: Int -> (NodeExp -> String -> String) -> [ADT] -> String+displayTrees w a = concatMap (displayTree w a)++foldHiddens :: [ADT] -> [ADT]+foldHiddens = trustMatchingFunction False f+              where+                f (Branch _ e@(NExpHidden _ _ _) _ _) = True+                f _ = False++trustIO :: [ADT] -> [ADT]+trustIO =+  trustMatchingFunction False f+  where+    f (Branch _ e _ _) =+      (NExpIdentifier undefined+                      (Plain "{IO}")+                      undefined) `isomorphicIn` finalResult e++trustUnevaluated :: [ADT] -> [ADT]+trustUnevaluated = trustMatchingFunction False +                                         (\(Branch _ e _ _)+                                            -> finalResult e === NExpUneval)++trustConstant :: QName -> [ADT] -> [ADT]+trustConstant name =+  trustMatchingFunction False f+  where+    f (Branch _ (NExpConstUse _ cName _) _ _) = name == cName+    f (Branch _ (NExpConstDef _ cName _) _ _) = name == cName+    f _ = False++trustModule :: String -> [ADT] -> [ADT]+trustModule mod =+  trustMatchingFunction False f+  where+    f (Branch _ (NExpApp _ (NExpIdentifier _ (Qualified mod' _) _) _ _) _ _)+      = mod == mod'+    f (Branch _ (NExpConstUse _ (Qualified mod' _) _) _ _)+      = mod == mod'+    f (Branch _ (NExpConstDef _ (Qualified mod' _) _) _ _)+      = mod == mod'+    f (Branch _ _ _ _) = False++trustApps :: [NodeExp] -> [ADT] -> [ADT]+trustApps apps trees =+  foldr trustApp trees apps+  where+    trustApp :: NodeExp -> [ADT] -> [ADT]+    trustApp exp = trustMatchingFunction False+                                         (  (compareApps exp)+                                          . (\(Branch _ e _ _) -> e))+    +    compareApps :: NodeExp -> NodeExp -> Bool+    compareApps (NExpApp _ f as _) (NExpApp _ f' as' _) =+         fullEval f === fullEval f'+      && all id (zipWith (===) (map fullEval as) (map fullEval as'))+    compareApps (NExpConstDef n _ _) (NExpConstDef n' _ _) = n == n'+    compareApps (NExpConstUse _ _ r) (NExpConstUse _ _ r') = compareApps r r'+    compareApps x y = False+++trustMatchingFunction :: Bool -> (ADT -> Bool) -> [ADT] -> [ADT]+trustMatchingFunction _ _ [] = []+trustMatchingFunction tc f (b@(Branch t e q ch):os)+  | f b       = if tc +                  then trustMatchingFunction tc f os+                  else    trustMatchingFunction tc f ch+                       ++ trustMatchingFunction tc f os+  | otherwise =   (Branch t e q (trustMatchingFunction tc f ch))+                : trustMatchingFunction tc f os +trustMatchingFunction tc f (c@(Cycle t xs):os) =+  (Cycle t (trustMatchingFunction tc f xs)) : (trustMatchingFunction tc f os)++subADTs :: Maybe Int -> [ADT] -> [ADT]+subADTs _ []+  = []+subADTs (Just 0) _+  = []+subADTs (Just n) (e@(Branch _ _ _ []):others)+  = e:subADTs (Just n) others+subADTs (Just n) (e@(Branch _ _ _ chldrn):others)+  = e:(subADTs (Just (n-1)) chldrn ++ subADTs (Just n) others)+subADTs Nothing (e@(Branch _ _ _ []):others)+  = e:subADTs Nothing others+subADTs Nothing (e@(Branch _ _ _ chldrn):others)+  = e:(subADTs Nothing chldrn ++ subADTs Nothing others)+subADTs x ((Cycle _ e):others)+  = subADTs x others++leaves :: ADT -> [NodeExp]+leaves (Branch _ e _ []) = [e]+leaves (Branch _ e _ chldrn) = e:(concatMap leaves chldrn)+leaves (Cycle t e) = []
+ tools/BlackHat.hs view
@@ -0,0 +1,168 @@+module Main where++import NonTermLib+import LowLevel +import SExp+import System.Cmd         (system)+import System.Environment (getArgs,getProgName,getEnv)+import System.Exit        (exitWith,ExitCode(..))+import Data.List          (isPrefixOf,isSuffixOf,group,groupBy)+import Control.Monad      (when)+import System.IO          (hSetBuffering,BufferMode(..),stdin,stdout,stderr+                          ,hPutStrLn,hFlush)+import Foreign.C.String   (withCString)+import HighlightStyle     (getTerminalSize)+++main = +  do args    <- System.Environment.getArgs+     prog    <- System.Environment.getProgName+     initialiseCount+     checkHelp args+     hatname <- getHatName args+     hatfile <- return (rectify hatname)+     withCString prog (\p-> withCString hatfile (openHatFile p))+     errmsg <- getErrorMessage+     (columns, lines) <- getTerminalSize+     let state = (setOptions args) { progname=hatname, file=hatfile+                                    , width=columns , height=lines }+     checkError state errmsg+     putStr ("---- Black Hat: " ++ hatname ++ " ----\n")+     showPath state+     if (showCount state) then  +       putStrLn ("No. reads from file: " ++ (show getCount) )+       else return ()+  where+    showPath state+        | bhpath == []     = do putStr (progname state)+	                        putStrLn (": no black hole found") +                                exitWith (ExitFailure 1)+	| (showNode state) = mapIO putStrLn+	                       (inter (map (showSctx state) bhpath) +			              (map show bhpath) )+        | otherwise = mapIO (putStrLn . showSctx state ) bhpath +      where bhpath = blackHoleSearch state getRootNode++    rectify :: FilePath -> FilePath+    rectify f | ".hat" `isSuffixOf` f = f+              | otherwise = f ++ ".hat"++    checkError :: State -> String -> IO ()+    checkError state msg  +      | msg `isPrefixOf` "<<loop>>" = return ()+      | otherwise = do hPutStrLn stderr ((progname state) +                                         ++": error is not a loop") +		       exitWith (ExitFailure 1)++    checkHelp args | member "--help" args = do showHelp+                                               exitWith ExitSuccess+                   | otherwise            = return ()++    getHatName args = +       case args of (f:_) -> return f+                    _     -> do hPutStrLn stderr +		                         ("black-hat: no trace file")+		                showHelpShort+                                exitWith (ExitFailure 1)++    showHelpShort = putStrLn "Usage: black-hat [PROGNAME] [OPTIONS]..."+    showHelp =+      do showHelpShort+         putStrLn "  --showqual={t,f}     Show function module names"+	 putStrLn "  --showrt={t,f}       Show all nodes from the root node" +	 putStrLn "  --srcref={t,f}       Show source references for nodes"+         putStrLn "  --cutoff=<int>       Cutoff expression at depth <int>"+++-- This function calls the function which implements the search process+-- proper. It also cuts off the head of the list, if the correct option +-- is set.+blackHoleSearch :: State -> FileNode -> [Sctx]+blackHoleSearch state startnode +    | (showRoot state) = reverse (map reverse resultpath)+    | otherwise        = cutAt node (reverse (map reverse resultpath))+  where +    (node, resultpath) = blackHoleSearchAux state [startnode] []+    +    cutAt _ [] = []                           -- shouldn't happen+    cutAt func (x:xs) | member node x = (x:xs)+                      | otherwise     = cutAt func xs+++-- This function looks for a black-hole path in the ART graph. It implements+-- the search process documented in the report. Basically, the function uses +-- a depth-first search of the ART graph.+-- +-- From the root node, each node is considered in turn.+--   * if it is the wrong kind of node (ie a Module, SrcPos) the function+--     returns (nil, []), indicating failure+--   * if it has already appeared on the search path, the search returns the+--     search path, and the head node, indicating success+--   * otherwise, the function calls itself on the node's result. If+--     any of them return a search path, indicating success, this path +--     is returned+--   * otherwise, the function calls itself on the node's children, as+--     above+--   * otherwise, the function returns (nil, []) indicating failure+blackHoleSearchAux :: State -> Sctx -> [Sctx] -> (FileNode, [Sctx])+blackHoleSearchAux state curr@(currnode:stack) path+    | haltAtNode currnode      = (nil, [])+    | nodeInPath currnode path = (currnode, (curr:path))+    | resultpath /= []         = (resultnode, resultpath)+    | otherwise                = searchChildren (getNodeChildren currnode)+  where+    nodeInPath currnode []     = False+    nodeInPath currnode (x:xs) +      | incMember currnode x = True+      | otherwise            = nodeInPath currnode xs+    +    incMember m [] = False+    incMember m (y:ys) | (showCount state) && +                         incrementCount 1 && m == y = True+		       | m == y                     = True+                       | otherwise                  = incMember m ys+    +    -- call the function on the node's result+    resultsctx = [(peekResultMod currnode)]+    (resultnode, resultpath) +      | (peekResult currnode) == currnode = (nil, [])+      | otherwise              = blackHoleSearchAux state resultsctx (curr:path)++    -- call the function on all of the node's children+    searchChildren [] = (nil, [])+    searchChildren (ch:rest) | childpath /= [] = (childnode, childpath)+                             | otherwise       = searchChildren rest+      where +	(childnode, childpath) = blackHoleSearchAux state chsctx path +	chsctx = (ch:currnode:stack)+++-- This function indicates if the search process should fail and+-- backtrack when it reaches a node.+haltAtNode node | node <= (FileNode 4)		= True+                | ntype == ExpApp		= False+                | ntype == ExpValueApp		= False+                | ntype == ExpValueUse		= False+                | ntype == ExpConstUse		= False+                | ntype == ExpConstDef		= False+                | ntype == ExpGuard		= False+                | ntype == ExpCase		= False+                | ntype == ExpIf		= False+                | ntype == ExpForward		= False+                | ntype == ExpProjection	= False+                | ntype == Module		= True+                | ntype == SrcPos		= True+                | ntype == ExpChar		= True+                | ntype == ExpInt 		= True+                | ntype == ExpInteger		= True+                | ntype == ExpRat		= True+                | ntype == ExpRational		= True+                | ntype == ExpFloat		= True+                | ntype == ExpDouble		= True+                | ntype == ExpFieldUpdate	= True+                | ntype == ExpHidden		= True+                | ntype == ExpDoStmt		= True+                | ntype == AtomVariable		= True+                | ntype == AtomConstructor	= True+                | ntype == AtomAbstract		= True+  where ntype = nodeType node
+ tools/CmdLine.hs view
@@ -0,0 +1,49 @@+module CmdLine (initialize,cmdline) where++-- simple hack to use the following+import System.Console.Haskeline(InputT, runInputT, defaultSettings, getInputLine)++initialize :: IO ()+initialize = return ()++cmdline :: String -> IO String+cmdline prompt = runInputT defaultSettings getLine+  where+  getLine :: InputT IO String+  getLine = do+    minput <- getInputLine prompt+    case minput of+      Nothing -> return ""+      Just input -> return input++{-+#if USE_READLINE++#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 600+import System.Console.Readline as Readline (initialize, readline, addHistory)+#else+import Readline (initialize, readline, addHistory)+#endif+import Char	(isSpace)+import Monad	(when)++cmdline :: String -> IO String+cmdline prompt = do+    ms <- Readline.readline prompt+    case ms of+        Nothing -> return ""+        Just s  -> do when (not (all isSpace s)) (Readline.addHistory s) +                      return s++#else++import IO (hFlush,stdout)++initialize :: IO ()+initialize = return ()++cmdline :: String -> IO String+cmdline prompt = do putStr prompt; hFlush stdout; getLine++#endif+-}
+ tools/CommonUI.hs view
@@ -0,0 +1,181 @@+module CommonUI+  ( hatObserve, hatTrail, hatDelta, hatDetect, hatAnim, hatExplore, hatView+  , shortHelpText+  , Keep(..)+  , Options(..), initialOptions+  , OptionCmd(..), optionCmd+  , onOff, number, safeReadInt+  , optionsUpdate, showOption, showOnOff+  ) where++import Data.List	(isPrefixOf,isSuffixOf,intersperse)+import Data.Char	(isDigit,digitToInt)+import Numeric	        (readDec)+import LowLevel	        (FileNode(..))+import HighlightStyle	(highlight,Highlight(..))+import SrcRef           (SrcRef(..))++-- Links to other hat-tools+hatObserve :: FilePath -> String -> String+hatObserve f pat = "xterm -e hat-observe "++f++" \""++esc pat++"\" &"+  where+      esc []        = []+      esc ('"':xs) = '\\': '"': esc xs+      esc ('$':xs) = '\\': '$': esc xs+      esc ('`':xs) = '\\': '`': esc xs+      esc (x:xs)    = x: esc xs++hatDelta :: FilePath -> FileNode -> String+hatDelta f n = "xterm -e hat-delta "++f++" "++show (int n)++" &"++hatDetect :: FilePath -> FileNode -> String+hatDetect f n = "xterm -e hat-delta --detect "++f++" "++show (int n)++" &"++hatTrail :: FilePath -> FileNode -> String+hatTrail f n  = "xterm -e hat-trail "++f++" -remote "++show (int n)++" &"++hatAnim :: FilePath -> FileNode -> String+hatAnim f n   = "xterm -e hat-anim "++f++" "++show (int n)++" &"++hatExplore :: FilePath -> FileNode -> String+hatExplore f n = "xterm -e hat-explore "++f++" "++show (int n)++" &"++hatView :: SrcRef -> String+hatView sr = "xterm -e hat-view "++SrcRef.filename sr++" "+                                 ++show (SrcRef.line sr)++" "+                                 ++show (SrcRef.column sr)++" "+                                 ++show (SrcRef.lineend sr)++" "+                                 ++show (SrcRef.columnend sr)++" &"++-- Interactive help+shortHelpText  = ":? for help, :q to quit"++-- Filtering modes+data Keep = All | Unique | MostGeneralSoFar | MostGeneral deriving Eq+instance Show Keep where+  showsPrec p All               = showString "all"+  showsPrec p Unique            = showString "unique"+  showsPrec p MostGeneralSoFar  = showString "generalise"+  showsPrec p MostGeneral       = showString "mostgeneral"++-- User-changeable display options+data Options =+    Options+	{ cutoffDepth   :: Int		-- expression auto-cutoff depth+	, unevalMode    :: Bool		-- show unevaluated stuff in full?+	, stringSugar   :: Bool		-- show strings with sugar?+	, listSugar     :: Bool		-- show lists with sugar?+	, recursiveMode	:: Bool		--+	, colourBracks  :: Bool+	, equations	    :: Bool		-- always show equations?+	, showQual	    :: Bool		-- show identifiers qualified?+	, filterMode	:: Keep		-- show duplicate equations?+	}+initialOptions = Options+	{ cutoffDepth	= 10+	, unevalMode	= False+	, stringSugar	= True+	, listSugar	= True+	, recursiveMode	= True+	, colourBracks = False+	, equations	= True+	, showQual	= False+	, filterMode	= Unique+	}++-- Command interpreter for setting display options+data OptionCmd+	= Uneval Bool | Strings Bool | Lists Bool | Recursive Bool+	| CutOff Int  | Deeper Int   | Shallower Int | Qualify Bool+	| Filter Keep | Equations Bool++optionCmd :: [String] -> Maybe OptionCmd+optionCmd (s:ss)+    | s `isPrefixOf` "uneval"      = onOff Uneval ss+    | s `isPrefixOf` "strSugar"    = onOff Strings ss+    | s `isPrefixOf` "listSugar"   = onOff Lists ss+    | s `isPrefixOf` "recursive"   = onOff Recursive ss+    | s `isPrefixOf` "all"         = Just (Filter All)+    | s `isPrefixOf` "unique"      = Just (Filter Unique)+    | s `isPrefixOf` "generalise"  = Just (Filter MostGeneralSoFar)+    | s `isPrefixOf` "mostgeneral" = Just (Filter MostGeneral)+    | s `isPrefixOf` "cutoff"      = Just (number CutOff ss 10)+    | s `isPrefixOf` "qualified"   = onOff Qualify ss+    | s `isPrefixOf` "equations"   = onOff Equations ss+    | s `isPrefixOf` "eqns"        = onOff Equations ss+    | head s == '+'                = Just (number Deeper (tail s:ss) 1)+    | head s == '-'                = Just (number Shallower (tail s:ss) 1)+    | otherwise                    = Nothing++onOff :: (Bool->a) -> [String] -> Maybe a+onOff mode s | null s    = Just (mode True)+             | otherwise = case head s of "on"     -> Just (mode True)+                                          "active" -> Just (mode True)+                                          "off"    -> Just (mode False)+                                          "no"     -> Just (mode False)+                                          _        -> Nothing++number :: (Int->a) -> [String] -> Int -> a+number cons s def = (cons . safeReadInt def . unwords) s++--safeRead takes a default value to return if the parse is not successful+safeReadInt :: Int -> String -> Int+safeReadInt d s =+  case readDec s of+    [] -> d+    ((n,_):_) -> n++-- change just one field of the Options value+optionsUpdate :: OptionCmd -> Options -> Options+optionsUpdate (Uneval b)    opts  =  opts { unevalMode = b }+optionsUpdate (Strings b)   opts  =  opts { stringSugar = b }+optionsUpdate (Lists b)     opts  =  opts { listSugar = b }+optionsUpdate (Recursive b) opts  =  opts { recursiveMode = b }+optionsUpdate (CutOff n)    opts  =  opts { cutoffDepth = n }+optionsUpdate (Deeper n)    opts  =  opts { cutoffDepth = cutoffDepth opts + n }+optionsUpdate (Shallower n) opts  =  opts { cutoffDepth =+						 max (cutoffDepth opts - n) 1 }+optionsUpdate (Qualify b)   opts  =  opts { showQual = b }+optionsUpdate (Filter k)    opts  =  opts { filterMode = k }+optionsUpdate (Equations b) opts  =  opts { equations = b }++-- describe one field of the Options value in English+showOption :: OptionCmd -> Options -> String+showOption (Uneval b)    opts  = "  "++highlight [Underscore] "uneval"+                                 ++ showOnOff (unevalMode opts)+                                 ++ "show unevaluated exprs in full"+showOption (Strings b)   opts  = "  "++highlight [Underscore] "strSugar"+                                 ++ showOnOff (stringSugar opts)+                                 ++ "sugar syntax for strings"+showOption (Lists b)     opts  = "  "++highlight [Underscore] "listSugar"+                                 ++ showOnOff (listSugar opts)+                                 ++ "sugar syntax for lists"+showOption (Recursive b) opts  = "  "++highlight [Underscore] "recursive"+                                 ++ showOnOff (recursiveMode opts)+                                 ++ "show recursive calls"+showOption (CutOff n)    opts  = "  "++highlight [Underscore] "cutoff"+                                 ++ "\t"++show (cutoffDepth opts)++"\t"+                                 ++ "expression cutoff depth"+showOption (Deeper n)    opts  = showOption (CutOff 0) opts+showOption (Shallower n) opts  = showOption (CutOff 0) opts+showOption (Qualify b)   opts  = "  "++highlight [Underscore] "qualified"+                                 ++ showOnOff (showQual opts)+                                 ++ "show identifier names fully qualified"+showOption (Filter k)    opts  = "  show ("+                                 ++ concat+                                     (intersperse ","+                                       (map keep [All,Unique,MostGeneralSoFar+                                                 ,MostGeneral]))+                                 ++ ") equations"+  where+    fm = filterMode opts+    keep k | k==fm      = highlight [Underscore] (show k)+           | otherwise  = show k+showOption (Equations b) opts  = "  "++highlight [Underscore] "equations"+                                ++ showOnOff (equations opts)+                                ++ "show right-hand-side of equations"++showOnOff :: Bool -> String+showOnOff True  = "\t"++ highlight [Bold] "on" ++"\t"+showOnOff False = "\toff\t"+
+ tools/Detect.hs view
@@ -0,0 +1,354 @@+{-# LANGUAGE EmptyDataDecls #-}++-- Low-level routines specifically for hat-detect.+module Detect+  ( findMain, findMainCall, edtNextChild+  , doObserve, doTrail, doDelta, doDetect, doAnim, doExplore, doView+  , identifyBug, identifyCycle+  , questionText, showHeuristic+  , ParentSet, newParentSet+  , anySuspect+  , DetectCommand(..), toCommand+  , DeltaOption(..), HeuristicMode(..), HeuristicBool(..)+  ) where++import Data.Char          (toLower,ord)+import System.Cmd         (system)+import System.Environment (getArgs,getProgName)+import System.Exit        (exitWith,ExitCode(..))+import Control.Monad      (when)++import LowLevel (FileNode(..),nil,unevaluated,SimpleNodeType(..)+                ,simpleNodeType,NodeType(..),nodeType,getSrcRef)+import Foreign.Ptr        (Ptr)+import System.IO.Unsafe   (unsafePerformIO)+import Numeric  (showHex)+import CommonUI (Options(..),hatAnim,hatDelta,hatDetect,hatExplore+                ,hatTrail,hatObserve,hatView)+import Explore  (Location(..),getLocation, getDefLocation,redexParent+                ,Coord(..))+import HighlightStyle (Highlight(..),Colour(..),highlight,getTerminalSize)+import PrettyLibHighlight+                (text, simple)+import SExp     (prettySExp)+import ADT      (ADT(..))+import NodeExp  (NodeExp(..),fullEval,flatEval,getNode,nodeExp2SExp+                ,removeResultCycles,nodeExpForNode,removeNonResultCycles+                ,fullEvalText,flatEvalText,children,finalResult,children)+import SrcRef	(readSrcRef)+import Slice    (Slice(..),sliceStartLine,sliceEndLine,sliceFile,offsetSlice+                ,highlightSlice,makeSlice,srcRef2Slice,RangeOrd(..))++data DeltaOption = Version+                 | ShowHelp+                 | QuickCheckMode+                 | SliceDepth Int+                 | DepthLimit Int+                 | DisableADTCompression+                 | NoSliceValue Float+                 | Heuristic HeuristicMode+                 | TreeType String+                   deriving Eq++data HeuristicMode = ValueHeuristic Float+                   | Correct+                   | Incorrect+                   | Add HeuristicMode HeuristicMode+                   | Negate HeuristicMode+                   | Multiply HeuristicMode HeuristicMode+                   | Invert HeuristicMode+                   | If HeuristicBool HeuristicMode HeuristicMode+                     deriving (Eq,Show,Read)+data HeuristicBool = TrueBool+                   | FalseBool+                   | Not HeuristicBool+                   | And HeuristicBool HeuristicBool+                   | Or HeuristicBool HeuristicBool+                   | Eq HeuristicMode HeuristicMode+                   | Gt HeuristicMode HeuristicMode+                   | Lt HeuristicMode HeuristicMode deriving (Eq,Show,Read)++data PS+type ParentSet = Ptr PS++data DetectCommand = Yes+                   | No+--                   | Maybe+--                   | MaybeYes+--                   | MaybeNo+                   | Quit+                   | Help+                   | Observe+                   | Trail+                   | Detect+                   | Delta+                   | Anim+                   | Explore+                   | View+                   | Split+                   | ShowADT+                   | ShowADTHs+                   | Children+                   | Set String String+                   | Get String+                   | Undo+                   | Unknown++toCommand :: String -> DetectCommand+toCommand cmd =+  case map toLower $ dropWhile (== ':') $ takeWhile (/=' ') cmd of+    "yes"      -> Yes+    "y"        -> Yes+    "true"     -> Yes+    "t"        -> Yes+    "no"       -> No+    "n"        -> No+    "false"    -> No+    "f"        -> No+    "quit"     -> Quit+    "q"        -> Quit+    "help"     -> Help+    "h"        -> Help+    "?"        -> Help+    "u"        -> Undo+    "undo"     -> Undo+    "observe"  -> Observe+    "trail"    -> Trail+    "detect"   -> Detect+    "delta"    -> Delta+    "anim"     -> Anim+    "animate"  -> Anim+    "explore"  -> Explore+    "source"   -> View+    "split"    -> Split+    "show"     -> ShowADT+    "adt"      -> ShowADT+    "adth"     -> ShowADTHs+    "children" -> Children+    "set"      -> Set var val+                  where+                    setText = dropWhile (==' ') $ dropWhile (/=' ') cmd+                    var = map toLower $ takeWhile (/=' ') setText+                    val = dropWhile (==' ') $ dropWhile (/=' ') setText+    "get"      -> Get var+                  where var = dropWhile (==' ') $ dropWhile (/=' ') cmd+    _          -> Unknown++doAnim :: NodeExp -> FilePath -> IO ()+doAnim exp f =+  do errCode <- system $ hatAnim f (getNode exp)+     checkOK errCode "hat-anim"++doDelta :: NodeExp -> FilePath -> IO ()+doDelta exp f =+  do errCode <- system $ hatDelta f (getNode exp)+     checkOK errCode "hat-delta"++doDetect :: NodeExp -> FilePath -> IO ()+doDetect exp f =+  do errCode <- system $ hatDetect f (getNode exp)+     checkOK errCode "hat-detect"++doExplore :: NodeExp -> FilePath -> IO ()+doExplore exp f =+  do errCode <- system $ hatExplore f (getNode exp)+     checkOK errCode "hat-explore"++doObserve :: NodeExp -> FilePath -> IO ()+doObserve exp f =+  do errCode <- system $ hatObserve f (flatEvalText 200 exp)+     checkOK errCode "hat-observe"++doTrail :: NodeExp -> FilePath -> IO ()+doTrail exp f = do errCode <- system $ hatTrail f (getNode exp)+                   checkOK errCode "hat-trail"++doView :: NodeExp -> IO ()+doView exp = do errCode <-   system+                           $ hatView+                           $ readSrcRef+                           $ getSrcRef+                           $ getNode exp+                checkOK errCode "hat-view"++identifyBug :: [DeltaOption] -> NodeExp -> String+identifyBug opts exp+  =    highlight [Background Red] "Bug identified:"+    ++ "\n  "+    ++ (showLocation opts exp)++identifyCycle :: [DeltaOption] -> [ADT] -> String+identifyCycle opts l+  =    highlight [Background Red] "Bug identified in cycling functions:"+    ++ "\n  "+    ++ concatMap (  (++ "\n---\n")+                  . (showLocation opts)+                  . (\(Branch _ n _ _) -> n))+                 l++showLocation :: [DeltaOption] -> NodeExp -> String+showLocation opts exp =+     show file ++ ":"+  ++ show functionStartOffset ++ "-"+  ++ show functionEndOffset ++ ":\n"+  ++ (if not(SliceDepth 0 `elem` opts) && maybeSlice /= Nothing then+        (highlightSlice offsetSubFunctionSlice $+                        getFileRange functionStartOffset functionEndOffset file)+      else getFileRange functionStartOffset functionEndOffset file)+--  ++ "\nSlice: " ++ show subFunctionSlice+--  ++ "\nNode: " ++ (show $ getNode exp)+  where+    (file,(Location {begin=Coord{row=functionStartOffset}+                    ,end=Coord{row=functionEndOffset}})) =+      getDefLocation (getNode exp)+    subFunctionSlice = (\(Just x) -> x) $ maybeSlice+    offsetSubFunctionSlice = offsetSlice (-functionStartOffset,0) 0+                                         subFunctionSlice+    maybeSlice = makeSlice 1 exp++getFileRange :: Int -> Int -> FilePath -> String+getFileRange s e =   unlines+                   . map ("  "++) +                   . drop (s - 1) +                   . take e+                   . lines+                   . unsafePerformIO+                   . readFile++showHeuristic :: (NodeExp -> Float)+              -> NodeExp+              -> String+              -> String+showHeuristic f e s =+  s ++ show (f e)++indent :: Int -> String -> String+indent n = tail . concatMap (("\n"++) . ((take n $ repeat ' ')++)) . lines++padTo :: Int -> String -> String+padTo n s = pad n (take n s)+            where+              pad n s = take (n - (length s)) (repeat ' ') ++ s++questionText :: Int ->+                (NodeExp -> String) ->+                (NodeExp -> String) ->+                NodeExp ->+                String+questionText w f g exp =+     mainQText w f g exp+  ++ withinText f exp+  where+    withinText :: (NodeExp -> String) ->+                  NodeExp ->+                  String+    withinText f exp =+      if    isQuestionable parent+         && pF == eF+         && (   (pSt <= eSt && pEnd > eEnd)+             || (pSt < eSt && pEnd >= eEnd))+        then let pExp = (  removeNonResultCycles+                         $ removeResultCycles+                         $ nodeExpForNode parent)+             in    "\nWithin:\n"+                ++ f pExp+                ++ withinText f pExp+        else ""+      where+        parent = redexParent $ getNode exp+        (pF,(Location {begin=Coord{row=pSt}+                      ,end=Coord{row=pEnd}})) = getDefLocation parent+        (eF,(Location {begin=Coord{row=eSt}+                      ,end=Coord{row=eEnd}})) = getDefLocation (getNode exp)+    subFunctionSlice = (\(Just x) -> x) $ makeSlice 1 exp++isQuestionable :: FileNode -> Bool+isQuestionable x = x > FileNode 5 && +                   (t == ExpApp || t == ExpConstUse || t == ExpConstDef)+                   where t = nodeType x++mainQText :: Int ->+           (NodeExp -> String) ->+           (NodeExp -> String) ->+           NodeExp ->+           String+mainQText w f g exp =+  if    numLines lhs == 1+     && numLines rhs == 1+     && (width lhs + width rhs) < (w - 4)+    then lhs ++ " = " ++ rhs+    else lhs ++ "\n=\n" ++ rhs+  where+    lhs = f exp+    rhs = g exp+    numLines :: String -> Int+    numLines = length . lines+    width :: String -> Int+    width = maximum . (map length) . lines . stripHidden+    stripHidden :: String -> String+    stripHidden [] = []+    stripHidden (x:xs) = if ord x == 27 then stripToM xs+                                        else x:stripHidden xs+                         where+                           stripToM [] = []+                           stripToM ('m':xs) = stripHidden xs+                           stripToM (x:xs) = stripToM xs++removeEscaping :: String -> String+removeEscaping [] = []+removeEscaping ('\ESC':xs) = removeEscaping $ tail $ dropWhile (/= 'm') xs+removeEscaping (x:xs) = x:(removeEscaping xs)++checkOK errcode s = when (errcode/=ExitSuccess)+                         (putStrLn ("ERROR: Unable to start "++s++"."))++file :: NodeExp -> FilePath+file = takeWhile (/= '.') . fst . getDefLocation . getNode++foreign import ccall "parentset.h" newParentSet    :: FileNode -> IO ParentSet+foreign import ccall "parentset.h" freeParentSet   :: ParentSet -> IO ()+foreign import ccall "parentset.h" extendParentSet :: ParentSet -> FileNode -> IO ()++foreign import ccall "detectutils.h" findMainUse   :: Bool -> IO FileNode+foreign import ccall "detectutils.h" nextChild     :: ParentSet -> IO FileNode+foreign import ccall "detectutils.h" anySuspect    :: FileNode -> IO Bool++findMain :: IO FileNode+findMain = findMainUse False++findMainCall :: IO FileNode+findMainCall = findMainUse True++-- For debugging:+-- foreign import ccall showParentSet   :: ParentSet -> IO ()++edtNextChild :: ParentSet -> IO FileNode+edtNextChild ps = do+ -- candidate ps+    c <- candidate ps+    b <- anySuspect c+    if c==LowLevel.nil || b then return c else edtNextChild ps+  where+  candidate ps = do+    c <- nextChild ps+ -- putStrLn ("edtNextChild: "++showHex (int c) "")+    if c==LowLevel.unevaluated	-- actually EOF+      then return LowLevel.nil+      else if c==LowLevel.nil+      then candidate ps+      else case simpleNodeType c of+        NodeConditional -> do extendParentSet ps c+                              --showParentSet ps+                              candidate ps+        NodeIdentifier  -> candidate ps+        NodeBasicValue  -> candidate ps+        NodeCAF         -> return c+        NodeApplication -> case nodeType c of+                             ExpApp      -> return c+                             ExpValueApp -> candidate ps+        NodeSugar       -> return c+        NodeSpecial     -> case nodeType c of+                             ExpProjection -> return c+                             _             -> do extendParentSet ps c+                                                 candidate ps+        _               -> error "unexpected node in edtNextChild"
+ tools/EDT.hs view
@@ -0,0 +1,45 @@+{-- | This module provides facilities for building Evaluation Dependancy Trees, +    | trusting of modules, functions and applications, displaying trees, and+    | finding parts of the tree.+    | --}+module EDT (buildEDT)+           where++import NodeExp (NodeExp(..),children,flatEvalText,fullEvalText)+import ADT     (ADT(..))+import Detect  (questionText)++-- | Creates an evaluation dependancy tree+buildEDT :: NodeExp -- ^ The trace to gather an EDT from -+                    -- ^ in the form of a NodeExp+         -> [ADT]+buildEDT = buildEDT' [1]+buildEDT' :: [Int] -> NodeExp -> [ADT]+buildEDT' t exp@(NExpApp n _ _ _) =+  [Branch t exp (edtQuestion exp) (concatZipWith (\e nt -> buildEDT' (nt:t) e)+                                                 (children exp)+                                                 [1..])]+buildEDT' t exp@(NExpConstUse n _ _) =+  [Branch t exp (edtQuestion exp) (concatZipWith (\e nt -> buildEDT' (nt:t) e)+                                                 (children exp)+                                                 [1..])]+buildEDT' t exp@(NExpConstDef n _ _) = +  [Branch t exp (edtQuestion exp) (concatZipWith (\e nt -> buildEDT' (nt:t) e)+                                                 (children exp)+                                                 [1..])]+buildEDT' t exp@(NExpCond n _ _ r) = +  buildEDT' t r+buildEDT' t exp@(NExpProjection n r) = +  buildEDT' t r+buildEDT' t exp@(NExpForward n r) = +  buildEDT' t r+buildEDT' t exp@(NExpHidden n _ _) =+  (concatZipWith (\e nt -> buildEDT' (nt:t) e)+                               (children exp)+                               [1..])+buildEDT' _ _ = []++concatZipWith f l1 l2= concat (zipWith f l1 l2)++edtQuestion :: NodeExp -> Int -> String+edtQuestion e w = questionText w (flatEvalText w) (fullEvalText w) e
+ tools/Explore.hs view
@@ -0,0 +1,119 @@+module Explore  (Coord(..),noCoord,isNoCoord,isNextCoord,beforeCoord+                ,afterCoord,Row,Col+                ,Location(..),isVirtLocation,isNoLocation+                ,isImproperLocation,mkLocation,getLocation+                ,getDefLocation,getUseLocation,hasUseLocation+                ,redexParent) where+import SrcRef   (readSrcRef,defnSrcRef)+import LowLevel (FileNode(..),nil,getSrcRef,getDefnRef,getParentNode+                ,NodeType(..),nodeType)+import Ident    (getIdentAt)+import System.IO.Unsafe (unsafePerformIO)+import Control.Monad (liftM)+import qualified SrcRef (SrcRef(..))++type Row = Int -- starts at 1, 0 for special purpose+type Col = Int -- starts at 1, 0 for special purpose++data Coord = Coord {row :: Row, col :: Col} deriving (Eq,Ord,Show)+  -- both always >= 0, start counting at 1 ++noCoord :: Coord+noCoord = Coord 0 0++isNoCoord :: Coord -> Bool+isNoCoord c = row c == 0 || col c == 0++isNextCoord :: Coord -> Coord -> Bool+-- only for same row, because impossible to say if end of row reached+-- and hence wrap around to next row should be made+isNextCoord c1 c2 = row c1 == row c2 && col c1 + 1 == col c2++beforeCoord :: Coord -> Coord+-- not for noCoord+beforeCoord c = +  if col c <= 1 then +    if row c <= 1 then+      error "beforeCoord start"+    else+      Coord{row=row c-1,col=maxBound}+  else+    c{col=col c-1}++afterCoord :: Coord -> Coord+-- not for noCoord+afterCoord c =+  if col c == maxBound then+    Coord{row=row c+1,col=1}+  else+    c{col=col c+1}+++-----------------------------------------------------------------------++data Location = Location {begin :: Coord, end :: Coord} deriving (Eq,Ord,Show)+  -- always begin <= end++isVirtLocation :: Location -> Bool+isVirtLocation l = isNoCoord (end l) && not (isNoCoord (begin l))++isNoLocation :: Location -> Bool+isNoLocation l = isNoCoord (begin l) && isNoCoord (end l)++isImproperLocation :: Location -> Bool+isImproperLocation = isNoCoord . begin++mkLocation :: Coord -> Coord -> Location+mkLocation b e = Location{begin=b,end=if e < b then noCoord else e} ++getLocation :: FileNode -> (FilePath,Location)+-- gets use location if it exists, +-- otherwise use location of parent, otherwise def location+getLocation node =+  if hasUseLocation node then getUseLocation node +    else let parent = redexParent node+         in if parent /= nil && hasUseLocation parent +              then getUseLocation parent +              else getDefLocation node++getDefLocation :: FileNode -> (FilePath,Location)+-- assumes given node is ValueUse, ConstUse or ValueApp (or App?)+getDefLocation node =+  (filename,Location{begin=Coord{row=rowBegin,col=colBegin}+                    ,end=Coord{row=rowEnd,col=colEnd}})+  where+  atomNode = getDefnRef node+  (SrcRef.SrcRef filename rowBegin colBegin rowEnd colEnd)+    | atomNode==nil = SrcRef.SrcRef "" 0 0 0 0+    | otherwise     = unsafePerformIO (liftM defnSrcRef (getIdentAt atomNode))++getUseLocation :: FileNode -> (FilePath,Location)+-- assumes given node has a location+getUseLocation node = +  (filename,Location{begin=Coord{row=rowBegin,col=colBegin}+                    ,end=Coord{row=rowEnd,col=colEnd}})+  where+  srcRefNode = getSrcRef node+  (SrcRef.SrcRef filename rowBegin colBegin rowEnd colEnd)+    | srcRefNode==nil  = SrcRef.SrcRef "" 0 0 0 0+    | otherwise        = readSrcRef srcRefNode++hasUseLocation :: FileNode -> Bool+hasUseLocation node = fst (getUseLocation node) /= ""++redexParent :: FileNode -> FileNode+-- returned parent redex is application or constDef, +-- never guard, case, if, update etc.+-- may however be nil+redexParent redex =+  let parent = getParentNode redex +  in if parent == nil then+       parent+     else+       case nodeType parent of+         ExpGuard -> redexParent parent+         ExpCase -> redexParent parent+         ExpIf -> redexParent parent+         ExpFieldUpdate -> redexParent parent  -- occurs?+         ExpHidden -> redexParent parent+         _ -> parent
+ tools/FDT.hs view
@@ -0,0 +1,198 @@+{-- | This module provides facilities for building Function Dependancy Trees, +    | trusting of modules, functions and applications, displaying trees, and+    | finding parts of the tree.+    | --}+module FDT (buildFDT)+           where++import System.IO.Unsafe   (unsafePerformIO)+import Data.List          ((\\))+import Data.Set as Set    (Set(..),empty,insert,toList,unions)++import NodeExp  (NodeExp(..),flatEvalText,fullEvalText,findAppsMatching,getNode+                ,branches,result,removeResultCycles,removeNonResultCycles+                ,nodeExpForNode,isDataConstructor)+import Explore  (redexParent)+import LowLevel (FileNode(..))+import ADT      (ADT(..))+import Detect   (questionText)+++type IndexEntry = (FileNode,ADT)++-- | Creates a function dependancy tree+buildFDT :: NodeExp -- ^ The trace to gather an FDT from -+                    -- ^ in the form of a NodeExp+         -> [ADT]+buildFDT = buildFDT' . replace++buildFDT' :: [IndexEntry] -> [ADT]+buildFDT' = zipWith tagTree (map (:[]) [1..]) . buildFromMap++buildFromMap xs =+  map (addChildren nonRoots) roots+  where+    (nonRoots,roots) = splitOn (parentIn $ map node xs) xs+    +    splitOn :: (a -> Bool) -> [a] -> ([a],[a])+    splitOn f [] = ([],[])+    splitOn f (x:xs)+      | f x       = let (ys,zs) = splitOn f xs in (x:ys,zs)+      | otherwise = let (ys,zs) = splitOn f xs in (ys,x:zs)+    +    parentIn ps (n,_) =+      (redexParent n) `elem` ps+    +    node :: IndexEntry -> FileNode+    node (_,Branch _ e _ _) = getNode e+    +    addChildren :: [IndexEntry] -> IndexEntry -> ADT+    addChildren ps n@(_,(Branch t exp f ocs)) = +      Branch t exp f (ocs ++ cs)+      where+        cs = map (addChildren ncIEs) cIEs+        (cIEs,ncIEs) = splitOn (parentIn [node n]) ps+    ++tagTree :: [Int] -> ADT -> ADT+tagTree t (Branch _ n f cs) = Branch t n f $ zipWith tagTree (map (:t) [1..]) cs+tagTree t (Cycle _ cs) = Cycle t $ zipWith tagTree (map (:t) [1..]) cs++concatZipWith f l1 l2= concat (zipWith f l1 l2)++fdtQuestion :: NodeExp -> Int -> String+fdtQuestion e w = questionText w (flatEvalText w) (fullEvalText w) e++replace :: NodeExp -> [(FileNode,ADT)]+replace n =+--  seq (unsafePerformIO $ putStrLn $ show nonRewritten) $+      map (applyMap nonRewritten) nonRewritten+  where+    makeMap :: [NodeExp] -> [IndexEntry]+    makeMap [] = []+    makeMap (x:xs) =+      (getNode $ getFunction x,Branch [] x (fdtQuestion x) []):makeMap xs+    +    nonRewritten = makeMap $ Set.toList $ gatherApps n+    +    gatherApps :: NodeExp -> Set NodeExp+    gatherApps a@(NExpApp n f _ r) =+      case r of+        NExpResultCycle n'+          -> if n == n' && isDataConstructor f+               then unions+               else added+        _ -> added+      where+        added = insert a unions+        unions = Set.unions $ map gatherApps $ branches a+    gatherApps a+      | null $ branches a = Set.empty+      | otherwise         = Set.unions $ map gatherApps $ branches a+    +    applyMap :: [IndexEntry] -> IndexEntry -> IndexEntry+    applyMap xs (n,Branch t exp _ cs) =+      (n,Branch t rExp (fdtQuestion rExp) cs)+      where+        rExp = rewrite xs exp+    +    rewrite :: [IndexEntry] -> NodeExp -> NodeExp+    rewrite xs (NExpApp n f as r) =+      NExpApp n (rewrite xs f) (map (findApps xs) as) (findApps xs r)+    rewrite xs (NExpConstUse n na r) = NExpConstUse n na (rewrite xs r)+    rewrite xs (NExpConstDef n na r) = NExpConstDef n na (rewrite xs r)+    rewrite xs (NExpCond n t c r) = NExpCond n t c (rewrite xs r)+    rewrite xs (NExpProjection n r) = NExpProjection n (rewrite xs r)+    rewrite xs (NExpForward n r) = NExpForward n (rewrite xs r)+    rewrite xs (NExpHidden n cs r) = NExpHidden n cs (rewrite xs r)+    rewrite xs y = y+    +    findApps :: [IndexEntry] -> NodeExp -> NodeExp+    findApps xs (NExpApp n f a r@(NExpResultCycle n'))+      | n == n'   = if isDataConstructor f+                      then NExpApp n (findApps xs f)+                                     (map (findApps xs) a)+                                     r+                      else let rs = map getNExp $ lookups n xs+                           in NExpExpanded n rs+      | otherwise = NExpApp n (findApps xs f)+                              (map (findApps xs) a)+                              r+    findApps xs (NExpApp n f a r) =+      NExpApp n (findApps xs f) (map (findApps xs) a) (findApps xs r)+    findApps xs (NExpConstUse n na r) = NExpConstUse n na (findApps xs r)+    findApps xs (NExpConstDef n na r) = NExpConstDef n na (findApps xs r)+    findApps xs (NExpCond n t c r) =+      NExpCond n t (findApps xs c) (findApps xs r)+    findApps xs (NExpFieldExp n exp ms) =+      NExpFieldExp n (findApps xs exp) (map doFAs ms)+      where+        doFAs (k,v) = (k,findApps xs v)+    findApps xs (NExpProjection n r) = NExpProjection n (findApps xs r)+    findApps xs (NExpForward n r) = NExpForward n (findApps xs r)+    findApps xs (NExpHidden n cs r) =+      NExpHidden n (map (findApps xs) cs) (findApps xs r)+    findApps xs (NExpLiteral n s) =+      if length rs == 0+        then NExpLiteral n s+        else NExpExpanded n rs+      where+        rs = map getNExp $ lookups n xs+    findApps xs (NExpIdentifier n na f) =+      if length rs == 0+        then NExpIdentifier n na f+        else NExpExpanded n rs+      where+        rs = map getNExp $ lookups n xs+    findApps _ x = x+    +    lookups :: Eq a => a -> [(a,b)] -> [b]+    lookups _ [] = []+    lookups x ((k,v):ys)+      | x == k    = v:lookups x ys+      | otherwise = lookups x ys+    +    getNExp :: ADT -> NodeExp+    getNExp (Branch _ exp _ _) = exp+    +dispApp :: NodeExp -> String+dispApp n = show n ++ " - " ++ (show $ redexParent $ getNode $ getFunction n) ++ "\n"++fdtChildren :: NodeExp -> [NodeExp]+fdtChildren exp@(NExpConstUse _ _ r) = fdtChildren r+fdtChildren exp@(NExpHidden _ _ _) =+  chldrn (getNode exp) (branches exp)+fdtChildren exp =+  (case result exp of+    NExpProjection n r -> chldrn (getNode pexp) (branches pexp)+                          where+                            pexp =   removeResultCycles+                                   $ removeNonResultCycles+                                   $ nodeExpForNode+                                   $ redexParent n+    _                  -> chldrn (getNode exp) (branches exp))++chldrn :: FileNode -> [NodeExp] -> [NodeExp]+chldrn n exps =+  (newApps ++ if null allApps+               then []+               else chldrn n (concatMap branches allApps))+  where+    newApps :: [NodeExp]+    newApps = concatMap (findAppsMatching (  (==n)+                                           . redexParent+                                           . getNode+                                           . getFunction))+                        exps+    allApps = concatMap (findAppsMatching (\_ -> True)) exps++getFunction :: NodeExp -> NodeExp+getFunction a@(NExpApp n f _ r) =+  case r of+    (NExpResultCycle n') ->+      if n == n'+        then a+        else getFunction f+    _                    ->+      getFunction f+getFunction a = a
+ tools/HatAnim.hs view
@@ -0,0 +1,297 @@+module Main where	-- HatAnim main program++import Data.Char          (toLower)+import LowLevel           (openHatFile,getBridgeValue,hatVersionNumber+                          ,FileNode(..),nil,peekTrace,getResult,getParentNode+                          ,getErrorLoc,getErrorMessage+                          ,getSrcRef,getDefnRef)+import NodeExp            (NodeExp(..),nodeExpForNode+                          ,compressClosures,removeResultCycles+                          ,removeNonResultCycles,limitDepth,hideFunction+                          ,fullEval,condEval,nodeExp2SExp+                          ,singleStepEval,getNode,(===))+import SExp               (SExp(..),prettySExp,optParens)+import HighlightStyle     (goto,cls,clearDown,clearUp,cleareol,highlightOff+                          ,highlight,Highlight(..),Colour(..)+                          ,enableScrollRegion,getTerminalSize+                          ,savePosition,restorePosition)+import System.Cmd         (system)+import System.Environment (getArgs,getProgName,getEnv)+import System.Exit        (exitWith,ExitCode(..))+import Data.List          (isPrefixOf,isSuffixOf,group,groupBy)+import System.IO          (hSetBuffering,BufferMode(..),stdin,stdout,stderr+                          ,hPutStrLn,hFlush)+import Data.Char          (digitToInt)+import Foreign.C.String   (withCString)+import Numeric            (showHex)+import CommonUI           (hatTrail,hatObserve,hatDetect,hatAnim,hatView+                          ,hatExplore,Keep(..)+                          ,Options(..),initialOptions+                          ,OptionCmd(..),optionCmd,onOff,number+                          ,optionsUpdate,showOption,showOnOff)+import Pretty             (PrettyOption(..),makeGraph)++data AnimState = AnimState {size :: (Int,Int),depth :: Int+                           ,hides :: [String],colouring :: Bool+                           ,rowsDisplayed :: Int,untouched :: NodeExp+                           ,command :: String}++main = do+    args    <- System.Environment.getArgs+    prog    <- System.Environment.getProgName+    hatfile <- case args of (f:_) -> return (rectify f)+                            _     -> do hPutStrLn stderr+                                                  ("hat-anim: no trace file")+                                        exitWith (ExitFailure 1)+    withCString prog (\p-> withCString hatfile (openHatFile p))+    errloc  <- getErrorLoc+    errmsg  <- getErrorMessage+    output  <- readOutputFile hatfile+    bridge  <- readBridgeFile+    let (start,end) = case args of+                       (_:s:e:_) -> (atoi s, atoi e)+                       (_:s:_)   -> (atoi s, 0)+                       _         -> (0,0)+    hSetBuffering stdin NoBuffering+    hSetBuffering stdout NoBuffering+    System.Cmd.system ("stty -icanon min 1 -echo")+    (columns,lines) <- getTerminalSize+    putStr (show start)+    let startExp = (removeNonResultCycles+                     (removeResultCycles+                       (nodeExpForNode+                         (FileNode start))))+    animLoop AnimState{size=(columns,lines),depth=10,hides=[],colouring=True+                      ,rowsDisplayed=1,untouched=startExp,command=""}++animLoop :: AnimState -> IO ()+animLoop state =+  animLoopRedraw state True+  where+    animLoopRedraw :: AnimState -> Bool -> IO ()+    animLoopRedraw state@AnimState{size=(cols,lines),rowsDisplayed=rows+                                  ,command=com}+                   fullDraw =+      do+        let+          animation :: String+          animation = if fullDraw then+                         interface (cols,lines)+                         ++ (goto 1 5)+                         ++ animText state+                      else ""+        putStr animation+        putStr (goto 1 lines ++ com ++ take (cols - length com) (repeat ' '))+        x <- getChar+        if x == '\n'+          then runCommand state+          else if x == '\b' then+            if com == "" then+              animLoopRedraw state{rowsDisplayed=if rows > 1 then rows-1+                                                             else rows}+                             True+            else+              animLoopRedraw state{command=removeLast com} False+          else+            animLoopRedraw state{command=com ++ [x]} False++animText :: AnimState -> String+animText AnimState{size=(cols,lines),depth=depth,hides=hides,colouring=colouring+                  ,rowsDisplayed=rows,command=com,untouched=untouched} =+  unlines $! (map indent text)+  where+    text :: [String]+    text = fittingLines outputLines++    fittingLines :: [String] -> [String]+    fittingLines lns+      = drop ((length lns) - numLines) revLines+        where+          revLines = (reverse lns)+          numLines = countLines 0 lns+          countLines :: Int -> [String] -> Int+          countLines l [] = 0+          countLines l (y:ys)+            = if (takenLines y) > (lines - l - 6) then 0+              else (countLines (l + takenLines y) ys) + 1+          takenLines :: String -> Int+          takenLines = (+1) . length . (filter (=='\n'))++    outputLines :: [String]+    outputLines =   reverse+                  $ take rows+                  $ map pretty+                  $ exps hides $  foldr hideFunction untouched hides+        +    pretty :: NodeExp -> String+    pretty exp = +      prettySExp ""+                 (cols - 3)+                 Options {listSugar=True,showQual=False,colourBracks=colouring+                         ,cutoffDepth=depth,unevalMode=True,stringSugar=True+                         ,equations=False,filterMode=Unique,recursiveMode=True}+                   (nodeExp2SExp+                     (limitDepth depth exp))+    +exps :: [String] -> NodeExp -> [NodeExp]+exps h e = e:if ns === e then [] else exps h ns+           where+             ns = foldr hideFunction (singleStepEval e) h++indent :: String -> String+indent xs = "-> " ++ (indAux xs)+            where+              indAux :: String -> String+              indAux [] = []+              indAux ('\n':xs) = "\n   " ++ (indAux xs)+              indAux (x:xs) = x:(indAux xs)++runCommand :: AnimState -> IO ()+runCommand state@AnimState{command = com} =+  getCommand command args state+  where+    (command, args) =+      case wrds of +        []        -> ("", [])+        otherwise -> (head wrds, tail wrds)+    wrds :: [String]+    wrds = words com++getCommand :: String -> [String] -> AnimState -> IO()+getCommand "" _ state@AnimState{rowsDisplayed=rows,untouched=untouched+                               ,hides=hides} =+  if length (exps hides (foldr hideFunction untouched hides)) == rows+    then animLoop state{rowsDisplayed=rows,command = ""}+    else animLoop state{rowsDisplayed=rows+1,command = ""}++getCommand ":q" [] _ =+  exitWith ExitSuccess++getCommand ":r" _ state =+  do (newCols,newLines) <- getTerminalSize+     animLoop state{size=(newCols,newLines),command = ""}+              +getCommand ":d" [] state@AnimState{size=(cols,lines),depth=depth} =+  do putStr (goto 1 lines ++ "depth: " ++ (show depth))+     getChar+     animLoop state{command = ""}++getCommand ":d" [newDepth] state@AnimState{size=(cols,lines)} =+  if isInteger newDepth+  then+    animLoop state{depth=(atoi newDepth),command = ""}+  else+    do invalid (cols,lines)+       animLoop state{command = ""}++getCommand ":h" [] state@AnimState{size=(cols,lines),hides=hides} =+  do putStr (goto 1 4 ++ clearDown)+     putStr (goto 1 4+            ++ "Hidden items: "+            ++ (take (cols - 15) (repeat '-')))+     putStr (goto 1 5 ++ (unlines hides))+     getChar+     animLoop state{command = ""}++getCommand ":h" args state@AnimState{hides=hides} =+  let newHides = (hides ++ args)+  in animLoop state{hides = newHides,command = ""}++getCommand ":uh" args state@AnimState{hides=hides} =+  let newHides = (removeAll args hides)+  in animLoop state{hides=newHides,command=""}++getCommand ":?" _ state@AnimState{size=(cols,lines)} =+  do putStr (goto 1 4 ++ clearDown)+     putStr (goto 1 4+            ++ "Help: "+            ++ (take (cols - 5) (repeat '-')))+     putStr (goto 1 5 +++            "Press return to advance one reduction step, and backspace to go back a reduction step.\n" +++            (highlight [Bold, Foreground Blue] "Commands:\n") +++            ":r     Resize the display.\n" +++            ":d     Display expression cutoff depth.\n" +++            ":d n   Set cutoff depth to n.\n" +++            ":h     Display all hidden expressions.\n"  +++            ":h x*  Hide application of all functions listed.\n" +++            ":uh x* Unhide application of all functions listed.\n" +++            ":c     Toggle bracket colouring.\n" +++            ":q     Exit hat-anim")+     getChar+     animLoop state{command = ""}++getCommand ":c" [] state@AnimState{colouring=colouring} =+  animLoop state{colouring = not colouring, command = ""}++getCommand _ _ state@AnimState{size = (cols,lines)} =+  do invalid (cols,lines)+     animLoop state{command = ""}++invalid :: (Int,Int) -> IO ()+invalid (_,lines) =+  do putStr (goto 1 lines ++ "INVALID COMMAND")+     getChar+     putStr ""++interface :: (Int,Int) -> String+interface (cols,lines) =+    (goto 1 1 ++ clearDown)+    ++ (goto 1 1 ++ "Output: " ++ take (cols - 8) (repeat '-'))+    ++ (goto 1 4 ++ "Animation: " ++ take (cols - 11) (repeat '-'))+    ++ (goto 1 (lines - 1) ++ take cols (repeat '-'))++removeLast :: [a] -> [a]+removeLast [] = []+removeLast [x] = []+removeLast (x:xs) = x:(removeLast xs)++isJust :: Maybe a -> Bool+isJust (Just x) = True+isJust _ = False++rectify :: FilePath -> FilePath+rectify f | ".hat" `isSuffixOf` f = f+          | otherwise = f ++ ".hat"++readOutputFile :: FilePath -> IO String+readOutputFile hat = do readFile (hat++".output")++readBridgeFile :: IO [FileNode]+readBridgeFile = do until (==nil) getBridgeValue+      where+        until :: (a->Bool) -> IO a -> IO [a]+        until pred action = do+          v <- action+          if pred v then return [] else do vs <- until pred action+                                           return (v:vs)++remove :: Eq a => a -> [a] -> [a]+remove x = filter (/= x)++removeAll :: Eq a => [a] -> [a] -> [a]+removeAll xs ys = foldr remove ys xs++stripWhiteSpace :: String -> String+stripWhiteSpace (' ':xs) = xs+stripWhiteSpace x = x++isInteger :: String -> Bool+isInteger [] = True+isInteger (x:xs) = isDigit x && isInteger xs++isDigit :: Char -> Bool+isDigit '0' = True+isDigit '1' = True+isDigit '2' = True+isDigit '3' = True+isDigit '4' = True+isDigit '5' = True+isDigit '6' = True+isDigit '7' = True+isDigit '8' = True+isDigit '9' = True+isDigit _ = False++atoi :: String -> Int+atoi [] = 0+atoi (x:xs) = (digitToInt x) * (10 ^ length xs) + atoi xs
+ tools/HatCheck.hs view
@@ -0,0 +1,25 @@+-- hat-check+-- verify the correct format of a *.hat file and calculate some statistics+-- independent of other libraries for reading the *.hat file format+--+-- Haskell wrapper for hat-check which is implemented in C++module Main where++import System.Environment (getProgName, getArgs)+import Foreign.C.Types (CInt)+import Foreign.C.String (newCString, CString)+import Foreign.Ptr (Ptr)+import Foreign.Marshal (free)+import Foreign.Marshal.Array (withArray)++foreign import ccall "hat_check"+  hatCheck :: Int -> Ptr CString -> IO ()+++main = do+  progName <- getProgName+  args <- getArgs+  listPtr <- mapM newCString (progName:args)+  withArray listPtr (hatCheck (length listPtr)) +  mapM_ free listPtr
+ tools/HatCover.hs view
@@ -0,0 +1,113 @@+-- HatCover: Colin Runciman, University of York, October 2004+-- Print Haskell sources highlighting the maximal expressions with+-- instances recorded in a given Hat trace.++module HatCover(hatCover, Interval, LC) where++import System.Environment (getProgName)+import LowLevel (openHatFile, NodeType(..), nodeSequence, FileNode(..), getSrcRef)+import Foreign.C.String (withCString)+import SrcRef (SrcRef(..), readSrcRef)++type SrcRef' = (String, Interval LC)+type Interval a = (a,a)+type LC = (Int,Int)++includes :: Ord a => Interval a -> Interval a -> Bool+includes (a,d) (b,c) = a <= b && c <= d++precedes :: Ord a => Interval a -> Interval a -> Bool+precedes (_,b) (c,_) = b < c++-- The record of which expressions have been covered is represented as a+-- tree of source intervals for each source-file.++type Cover = [(String, Tree (Interval LC))]+data Tree a = Leaf | Fork (Tree a) a (Tree a)++normalTree :: Tree a -> Bool+normalTree Leaf         = True+normalTree (Fork _ _ _) = True++fork :: Tree a -> a -> Tree a -> Tree a+fork back x forw | normalTree back && normalTree forw = Fork back x forw++normalList :: [a] -> Bool+normalList []    = True+normalList (_:_) = True++cons :: a -> [a] -> [a]+cons x xs | normalList xs = x : xs++add :: SrcRef' -> Cover -> Cover+add (f,i) [] = [(f, single i)]+add (f,i) ((g,t):etc) =+  if f==g then coverCons (g,insert i t) etc+  else cons (g,t) (add (f,i) etc)+  where+  coverCons st@(s,t) cvr | normalTree t = st : cvr++addAll :: [SrcRef'] -> Cover -> Cover+addAll []       cvr | normalList cvr = cvr+addAll (sr:srs) cvr | normalList cvr = addAll srs (add sr cvr)++single :: a -> Tree a+single x = Fork Leaf x Leaf++insert :: Ord a => Interval a -> Tree (Interval a) -> Tree (Interval a)+insert i Leaf = single i+insert i t@(Fork back j forw) =+  if      i `precedes` j then fork (insert i back) j forw+  else if j `precedes` i then fork back j (insert i forw)+  else if j `includes` i then t+  else {- i `includes` j -} fork (back `outside` i) i (forw `outside` i)+  +outside :: Ord a => Tree (Interval a) -> Interval a -> Tree (Interval a)+outside Leaf _ = Leaf+outside (Fork back ab forw) cd =+  if      ab `precedes` cd then fork back ab (forw `outside` cd)+  else if cd `precedes` ab then fork (back `outside` cd) ab forw+  else {- cd `includes` ab -} graft (back `outside` cd) (forw `outside` cd) ++graft :: Tree (Interval a) -> Tree (Interval a) -> Tree (Interval a)+graft Leaf t = t+graft (Fork back i forw) t = fork back i (graft forw t)++flatten :: Tree a -> [a]+flatten Leaf = []+flatten (Fork back i forw) = flatten back ++ [i] ++ flatten forw+++hatCover :: FilePath -> [String] -> IO [(String, [Interval LC])]+hatCover hatfile moduleNames = do+    prog    <- getProgName+    withCString prog (withCString hatfile . openHatFile)+    nodes   <- nodeSequence+    let srs = [ convert sr |+                (fn,nt) <- nodes, isCover nt,+                let srn = getSrcRef fn, srn /= FileNode 0,+		let sr = readSrcRef srn, line sr /= 0,+		null moduleNames || filename sr `elem` moduleNames ]+    return [(a, flatten b) | (a,b) <- addAll srs []]+++isCover :: NodeType -> Bool+isCover ExpApp         = True+isCover ExpValueApp    = True+isCover ExpChar        = True+isCover ExpInt         = True+isCover ExpInteger     = True+isCover ExpRat         = True+isCover ExpRational    = True+isCover ExpFloat       = True+isCover ExpDouble      = True+isCover ExpValueUse    = True+isCover ExpConstUse    = True+isCover ExpFieldUpdate = True+isCover ExpProjection  = True+isCover other          = False++convert :: SrcRef -> SrcRef'+convert (SrcRef fn ls cs le ce) = (fn, ((ls,cs),(le,ce)))++
+ tools/HatCoverText.hs view
@@ -0,0 +1,90 @@+-- HatCover: Colin Runciman, University of York, October 2004+-- Print Haskell sources highlighting the maximal expressions with+-- instances recorded in a given Hat trace.++import HighlightStyle (highlightOn, highlightOff, Highlight(..), Colour(..))+import Data.List (isPrefixOf, isSuffixOf)+import System.IO (stderr, hPutStrLn)+import System.Environment (getArgs, getProgName)+import System.Exit (exitWith, ExitCode(..))+import HatCover (hatCover, Interval, LC)+++printCover :: (String, String) -> [(String, [Interval LC])] -> IO ()+printCover hiOnOff = mapM_ (printModuleCover hiOnOff)++printModuleCover :: (String, String) -> (String, [Interval LC]) -> IO ()+printModuleCover hiOnOff (f, c) =+  do+    src <- readFile f+    printLo hiOnOff (1,1) c (map expand (lines src))++printLo :: (String, String) -> LC -> [Interval LC] -> [String] -> IO ()+printLo _ _      [] srcLines =+  mapM_ putStrLn srcLines+printLo hiOnOff (lineNo,colNo) (((lstart,cstart),(lstop,cstop)):ivals) srcLines =+  do+    mapM_ putStrLn (take lnLo srcLines)+    putStr (take chLo (head srcLines'))+    printHi hiOnOff+      (lstart,cstart) (lstop,cstop) ivals+      (drop chLo (head srcLines') : tail srcLines')+  where+  lnLo = lstart-lineNo+  chLo = cstart-(if lnLo==0 then colNo else 1)+  srcLines' = drop lnLo srcLines +  +printHi :: (String, String) -> LC -> LC -> [Interval LC] -> [String] -> IO ()+printHi hiOnOff (lineNo,colNo) (lstop,cstop) ivals srcLines =+  do+    mapM_ (putStrLn . high hiOnOff) (take lnHi srcLines)+    putStr (high hiOnOff (take chHi (head srcLines')))+    printLo hiOnOff+      (lstop,cstop+1) ivals+      (drop chHi (head srcLines') : tail srcLines')    +  where+  lnHi = lstop-lineNo+  chHi = 1+cstop-(if lnHi==0 then colNo else 1)+  srcLines' = drop lnHi srcLines+  +high :: (String, String) -> String -> String+high (hiOn, hiOff) s =+  takeWhile (==' ') s ++ hiOn ++ dropWhile (== ' ') s ++ hiOff++main =+  do+    args    <- getArgs+    prog    <- getProgName+    let (options, nonOptions) = span ("-" `isPrefixOf`) args+    let hiOnOpt  = [drop (length "-hion=") opt | opt <- options,+                                                 "-hion=" `isPrefixOf` opt]+    let hiOn     = if null hiOnOpt then highlightOn [Bold] else head hiOnOpt+    let hiOffOpt = [drop (length "-hioff=") opt | opt <- options,+                                                  "-hioff=" `isPrefixOf` opt]+    let hiOff    = if null hiOnOpt then highlightOff else head hiOffOpt+    hatfile <- case nonOptions of+               (t:_) -> return (rectify ".hat" t)+               _     -> do hPutStrLn stderr (prog++": no trace file")+                           exitWith (ExitFailure 1)+    let moduleNames = map (rectify ".hs") (tail nonOptions)+    res <- hatCover hatfile moduleNames+    printCover (hiOn, hiOff) res++rectify :: String -> FilePath -> FilePath+rectify ext f | ext `isSuffixOf` f = f+              | otherwise          = f ++ ext++expand :: String -> String+expand = expandFrom 1++expandFrom :: Int -> String -> String+expandFrom _ "" = ""+expandFrom n (x:xs) = f (expandFrom (n+d) xs)+  where+  (d, f) = if x=='\t' then (8 - (n-1)`mod`8, (take d spaces ++))+                      else (1, (x:))++spaces :: String+spaces = repeat ' '++
+ tools/HatDelta.hs view
@@ -0,0 +1,707 @@+module Main where++-- System Imports+import System.IO     (stdin,stdout,stderr,hPutStrLn)+import Data.List     (isSuffixOf, intersperse, nubBy, delete, minimumBy+                     ,isPrefixOf, sortBy)+import Data.Char     (toLower)+import System.Cmd    (system)+import System.Environment (getArgs,getProgName)+import System.Exit   (exitWith,ExitCode(..))+import Foreign.C.String (withCString)+import Numeric       (showHex)+import System.IO.Unsafe (unsafePerformIO)+import Data.Maybe    (fromJust)++-- Hat Imports+import CommonUI       (Options(..))+import Detect         (doAnim,doDelta,doDetect,doExplore,doObserve,doTrail+                      ,doView,findMain,DetectCommand(..),toCommand,identifyBug+                      ,identifyCycle,findMain,DeltaOption(..),HeuristicMode(..)+                      ,HeuristicBool(..),DetectCommand(..),toCommand+                      ,showHeuristic)+-- import Delta          (questions)+import HighlightStyle (Highlight(..),Colour(..),highlight,getTerminalSize)+import LowLevel       (NodeType(..),openHatFile,FileNode(..),nil,peekTrace+                      ,getResult,getParentNode,getErrorLoc,getErrorMessage+                      ,getSrcRef,getDefnRef,getSubExprs,nodeType)+import SExp           (QName(..),showQN,prettySExp)+import NodeExp        (NodeExp(..),nodeExpForNode,fullEval,flatEval+                      ,removeResultCycles,removeNonResultCycles,getNode+                      ,nodeExp2SExp,isIn,limitDepth,children,(===)+                      ,flatEvalText,fullEvalText,finalResult)+import ADT            (ADT(..),displayTree,displayTrees,trustIO+                      ,trustModule,trustApps,trustConstant,leaves,subADTs+                      ,detectCycles,foldHiddens,trustUnevaluated,(/==)+                      ,trustMatchingFunction)+import EDT            (buildEDT)+import FDT            (buildFDT)+import Explore        (Location(..),getLocation, getDefLocation,redexParent+                      ,Coord(..))+import Pretty         (PrettyOption(..), makeGraph)+import Slice          (Slice,makeSlice)++helpMessage :: String+helpMessage = "\+\hat-delta\n\+\=========\n\+\\n\+\hat-delta is an interactive tool for finding bugs in the trace of a \n\+\program supplied as its argument.  The user must answer a sequence of\n\+\yes/no questions.  Each question asked by hat-delta concerns the reduction \n\+\of a function application to a value.  You answer yes if the reduction is\n\+\correct with respect to your intentions, and no otherwise. After a number \n\+\of questions hat-delta reports an example equation which is the cause of\n\+\the observed faulty behaviour - that is, which function definition is\n\+\incorrect.\n\+\\n\+\Options:\n\+\-------------------------------------------------------------------------\n\+\-c             Disable compression of the ADT based on reporting the same\n\+\               answer for several questions.\n\+\-d depth       Set the maximum depth hat-delta will consider making a jump\n\+\               into the ADT.\n\+\-f function    Set the heuristic function that hat-delta should use.\n\+\               Heuristic functions are input in the form of a Haskell data\n\+\               structure:\n\+\               ValueHeuristic n A floating point value - n\n\+\               Correct          The number of correct evaluations of the\n\+\                                slice.\n\+\               Incorrect        The number of incorrect evaluations of the\n\+\                                slice.\n\+\               Add f1 f2        Add the values of f1 and f2.\n\+\               Negate f         Negate the value of f.\n\+\               Multiply f1 f2   Multiply the values of f1 and f2.\n\+\               Invert f         Invert the value of f.\n\+\-h             Display this help message and exit.\n\+\-n             Set the default value of the heuristic when no slice data\n\+\               is available.\n\+\-q             Read QuickCheck tests to grab data.\n\+\-s sliceDepth  Set the number of child connections hat-delta will follow\n\+\               when generating a program slice.\n\+\-v             Print hat-delta's version number, and exit.\n\+\-------------------------------------------------------------------------\n\+\\n\+\Interactive Commands:\n\+\-------------------------------------------------------------------------\n\+\The hat-delta browser asks you questions, so the basic mode of interaction\n\+\is to type answers:\n\+\yes       Yes, the equation looks correct by my understanding of the\n\+\          meaning of the function.\n\+\no        No, the equation looks incorrect.  Given the displayed arguments,\n\+\          the function is returning the wrong result.\n\+\\n\+\:show     Show the ADTs that hat-delta is currently investigating.\n\+\\n\+\:quit     Exit the interactive tool.\n\+\:help     Shows this help text.\n\+\\n\+\:anim     Start the hat-anim browser in a new window, beginning with the\n\+\          currently queried reduction.\n\+\:delta or Start the hat-delta browser in a new window, beginning with the\n\+\:split    currently queried reduction.\n\+\:detect   Start the hat-detect browser in a new window, beginning with\n\+\          the currently queried reduction.\n\+\:explore  Start the hat-explore browser in a new window, beginning with\n\+\          the currently queried reduction.\n\+\:trail    Start the hat-trail browser in a new window, beginning with the\n\+\          currently queried reduction.\n\+\\n\+\:set      Set an option in the form `:set option value`. Options are:\n\+\          depthLimit   Set the maximum depth hat-delta will consider\n\+\                       making a jump into the ADT. Must be greater\n\+\                       than 0.\n\+\          sliceDepth   Set the number of child connections hat-delta will\n\+\                       follow when generating a program slice. Must be\n\+\                       positive.  A depth of 0 indicates that the whole\n\+\                       function definition should be used as a slice.\n\+\          heuristic    Set the heuristic function that hat-delta should\n\+\                       use.  As described in the command line options\n\+\                       section.\n\+\-------------------------------------------------------------------------\n"++main = do args    <- System.Environment.getArgs+          prog    <- System.Environment.getProgName+          let (modName,options) = getOptions args+          options <- if Version `elem` options+                        then do hPutStrLn stdout versionString+                                exitWith ExitSuccess+                     else if ShowHelp `elem` options+                        then do hPutStrLn stdout helpMessage+                                exitWith ExitSuccess+                     else if modName == ""+                        then do hPutStrLn stderr (usage "no root module")+                                exitWith (ExitFailure 1)+                     else if "--detect" `elem` args+                        then do hPutStrLn stdout hatDetectWarning+                                return $ defaultOptions options+                     else+                        return $ defaultOptions options+          withCString prog (\p -> withCString (hatFile modName) (openHatFile p))+          main <- findMain+          detect (modName,options) $ (removeNonResultCycles . removeResultCycles . nodeExpForNode) main++progName :: String+progName = "hat-delta"++hatDetectWarning :: String+hatDetectWarning =+  highlight [Background Blue] "Warning: hat-detect is now obsolete.  Most users should use hat-delta instead.  hat-delta will now be run in a mode that immitates the behaviour of hat-detect."++version :: Float+version = 2.72++versionString :: String+versionString = progName ++ " version: " ++ (show version) ++ "\n" +++                "(c) 2005 Thomas Davie\n"++usage :: String -> String+usage err = progName ++ ": " ++ err ++ "\n" +++            "usage: " ++ progName ++ "[-chqv] [-d depth] [-f heuristicFunction] [-n defaultHeuristicValue] [-s sliceDepth] prog[.hat]"++getOptions :: [String] -> (FilePath, [DeltaOption])+getOptions [] = ("",[])+getOptions (arg:args)+  | arg == "-c"+    = let (f,opts) = getOptions args in (f,DisableADTCompression:opts)+  | arg == "-d"+    = let+        getDepthLimit [] = ("",[])+        getDepthLimit (x:xs) = let (f,opts) = getOptions xs+                               in (f,(DepthLimit $ read x):opts)+      in getDepthLimit args+  | arg == "-f"+    = let+        getHeuristicFunction (x:xs) =+          (f,(Heuristic $ read x):opts)+          where+            (f,opts) = getOptions xs+      in getHeuristicFunction args+  | arg == "-h"+    = let (f,opts) = getOptions args in (f,ShowHelp:opts)+  | arg == "-n"+    = let +        getSliceDepth [] = ("",[])+        getSliceDepth (x:xs) = let (f,opts) = getOptions xs+                               in (f,(NoSliceValue $ read x):opts)+      in getSliceDepth args+  | arg == "-q"+    = let (f,opts) = getOptions args in (f,QuickCheckMode:opts)+  | arg == "-s"+    = let +        getSliceDepth [] = ("",[])+        getSliceDepth (x:xs) = let (f,opts) = getOptions xs+                               in (f,(SliceDepth $ read x):opts)+      in getSliceDepth args+  | arg == "-t"+    = let+        getTreeType [] = ("",[])+        getTreeType (x:xs) = let (f,opts) = getOptions xs+                             in (f,(TreeType $ map toLower x):opts)+      in getTreeType args+  | arg == "-v"+    = let (f,opts) = getOptions args in (f,Version:opts)+  | arg == "--detect"+    = let (f,_) = getOptions args+      in (f, [ DisableADTCompression+             , DepthLimit 1+             , SliceDepth 1+             , Heuristic (ValueHeuristic 0.0)])+  | otherwise+    = let (_,opts) = getOptions args in (arg,opts)++defaultOptions :: [DeltaOption] -> [DeltaOption]+defaultOptions =+  defaultTreeType . defaultHeuristic . defaultSliceDepth . defaultDepthLimit+  where+    defaultSliceDepth :: [DeltaOption] -> [DeltaOption]+    defaultSliceDepth options =+      if length (filter isSliceDepth options) == 0+        then (SliceDepth 1:options)+        else options+    defaultDepthLimit :: [DeltaOption] -> [DeltaOption]+    defaultDepthLimit options =+      if length (filter isDepthLimit options) == 0+        then (DepthLimit 3:options)+        else options+    defaultHeuristic :: [DeltaOption] -> [DeltaOption]+    defaultHeuristic options = +      if length (filter isHeuristic options) == 0+        then (Heuristic (Negate+                          (If (Eq (Add Correct Incorrect)+                                  (ValueHeuristic 0.0))+                              (+                               Multiply (ValueHeuristic 1.0)+                                        (Invert (ValueHeuristic 2.0))+                              )+                              (+                               Multiply Correct+                                        (Invert (Add Correct Incorrect))+                              )+                          )+                        )+               :options)+        else options+    defaultTreeType :: [DeltaOption] -> [DeltaOption]+    defaultTreeType options =+      if length (filter isTreeType options) == 0+        then TreeType "edt" : options+        else options++detect :: (FilePath, [DeltaOption]) -> NodeExp -> IO()+detect opts = interact . questions opts++hatFile :: FilePath -> FilePath+hatFile = (flip rectify) ".hat"++rectify :: FilePath -> String -> FilePath+rectify f ext | ext `isSuffixOf` f = f+              | otherwise = f ++ ext++--- To be removed++data SliceKnowledge = Kn Slice Int Int++trustedModules = ["Prelude", "IO", "Data.Set", "Data.List", "Data.Map"]++instance Show SliceKnowledge where+  show (Kn sl wr cr) =+       show sl+    ++ ": "+    ++ show wr+    ++ " - "+    ++ show cr++data DeltaKnowledge = Slices [SliceKnowledge]++isSliceDepth :: DeltaOption -> Bool+isSliceDepth (SliceDepth _) = True+isSliceDepth _ = False++isDepthLimit :: DeltaOption -> Bool+isDepthLimit (DepthLimit _) = True+isDepthLimit _ = False++isHeuristic :: DeltaOption -> Bool+isHeuristic (Heuristic _) = True+isHeuristic _ = False++isTreeType :: DeltaOption -> Bool+isTreeType (TreeType _) = True+isTreeType _ = False++isNothing :: Maybe a -> Bool+isNothing Nothing = True+isNothing _ = False++-- Questions are generated by making a list of booleans of answers+-- and then generating a list of questions based on that.  We start+-- with the empty set of knowledge... This may change when we start+-- reading in a corrert program.+questions :: (FilePath, [DeltaOption]) -> NodeExp -> String -> String+questions opts exp =+    unlines+  . map ("\n" ++)+  . (makeQuestions opts exp (Slices []))+  . (map toCommand)+  . lines++-- Make questions makes a list of questions to ask in order+-- to find a bug in the expression given as the first argument.+-- The second argument is a list of answers to the questions.+-- This function must be able to produce at least one question+-- without needing anything from the answer list.+--+-- This implementation simply calls mkQuestions+-- with the continuation (what to do if the user answers no to+-- the first question) being a function that displays "no+-- bugs found".++makeQuestions :: (FilePath, [DeltaOption])+              -> NodeExp+              -> DeltaKnowledge+              -> [DetectCommand]+              -> [String]+makeQuestions (f,opts) n k@(Slices sl) as =+  mkQuestions (f,opts) [(compressTree tree)] newMessage [newKnowledge] as+  where+    newKnowledge =+      if QuickCheckMode `elem` opts+        then Slices+               (compressSlices+                 (   sl+                  ++ (map makeCorrect $ slices opts lvs)+                  ++ (map makeIncorrect+                          (slices opts+                                  (map (\(Branch _ x _ _) -> x) $ snd tests)))))+        else k+    lvs = take 100 $ concat $ map leaves $ fst tests+    tests = collectTests wholeTree+    collectTests :: [ADT] -> ([ADT],[ADT])+    collectTests =   splitOnPass+                   . concat+                   . map findTests+    compressTree =+      if DisableADTCompression `elem` opts+        then id+        else map (removeIrrelevantQuestions opts)+        +    findTests b@(Branch _ (NExpApp _ f _ _) _ ch) =+      case finalResult f of+        NExpIdentifier _ (Plain name) _+          -> if "prop_" `isPrefixOf` name+               then [b]+               else (concat $ map findTests ch)+        NExpIdentifier _ (Qualified _ name) _+          -> if "prop_" `isPrefixOf` name+               then [b]+               else (concat $ map findTests ch)+        otherwise+          -> (concat $ map findTests ch)+    findTests x = []+    +    splitOnPass xs = splitOnPassAux xs ([],[])+    splitOnPassAux [] (ps,fs) = (ps,fs)+    splitOnPassAux (b@(Branch _ test _ _):xs) (ps,fs) =+      case finalResult test of+        NExpIdentifier _ name _+          -> if name == Plain "True"+              then splitOnPassAux xs (b:ps,fs)+              else splitOnPassAux xs (ps,b:fs)+        otherwise+          -> splitOnPassAux xs (ps,fs)+    +    tree =+      if quickCheckMode+        then sortTree workingQCTree+        else wholeTree+      where+        sortTree (Branch _ _ _ ch) = ch+        sortTree (Cycle _ _) = [] +    +    treeDepth :: Int -> ADT -> Int+    treeDepth = treeDepth' 0+                where+                  treeDepth' :: Int -> Int -> ADT -> Int+                  treeDepth' c m (Branch _ n _ ch)+                    | c == m    = m+                    | otherwise = case ds of+                                    []     -> c+                                    (x:xs) -> maximum ds+                                  where+                                    ds = (map (treeDepth' (c+1) m) ch)+                  treeDepth' c _ (Cycle _ _) = c+    +    newMessage = if quickCheckMode+                   then [identifyTree opts workingQCTree]+                   else ["No bugs found"]+    +    workingQCTree = head (snd tests)+    +    quickCheckMode :: Bool+    quickCheckMode = QuickCheckMode `elem` opts+    +    (TreeType tt) = head $ filter isTreeType opts+    +    wholeTree = (  trustConstant (Plain "otherwise")+                 . (flip (foldr trustModule) trustedModules)+                 . detectCycles+                 . trustUnevaluated+                 -- . trustIO+                 . foldHiddens+                 . (if tt == "fdt"+                      then buildFDT+                      else buildEDT)) n++identifyTree :: [DeltaOption] -> ADT -> String+identifyTree opts (Branch _ n _ _) = identifyBug opts n+identifyTree opts (Cycle _ e) = identifyCycle opts e++mkQuestions :: (FilePath, [DeltaOption])+            -> [[ADT]]+            -> [String]+            -> [DeltaKnowledge]+            -> [DetectCommand]+            -> [String]+mkQuestions _ ([]:_) (report:_) _ _ = [report]+mkQuestions (f,opts)+            (edts@(hd@(Branch _ exp disp chldr):others):prevADTs)+            (report:prevReports)+            (kn@(Slices sl):prevKns)+            ans+  = f' width+    : case ans of+        []            -> ["End of input, exiting"]+        (Yes:xs)      ->+          let lvs = take 100 $ leaves edt'+              compareQuestions (Branch _ n _ _) (Branch _ n' _ _) =+                (flatEval fullEval n) === (flatEval fullEval n')+              compareQuestions (Cycle _ xs) (Cycle _ xs') =+                and (zipWith compareQuestions xs xs')+              compareQuestions _ _ = False+          in mkQuestions (f,opts)+                         ( (trustMatchingFunction True+                                                  (compareQuestions edt')+                                                  edts)+                          :edts:prevADTs)+                         (report:report:prevReports)+                         ((Slices+                            $ compressSlices (sl ++ (map makeCorrect +                                                         $ slices opts lvs)))+                          :kn:prevKns)+                         xs+        (No:xs)       ->+          mkQuestions (f,opts)+                      (ch:edts:prevADTs)+                      ((identifyBug opts exp'):report:prevReports)+                      ((Slices+                         $ compressSlices (sl ++ (map makeIncorrect+                                                      $ slices opts [exp'])))+                       :kn:prevKns)+                      xs+        (Undo:xs)     ->+          mkQuestions (f,opts)+                      prevADTs+                      prevReports+                      prevKns+                      xs+        (Quit:_)      -> ["User Quit.  No Bugs Found"]+        (Help:_)      -> helpMessage : repeatQuestion+        (Anim:_)      -> seq (unsafePerformIO $ doAnim exp f)+                             repeatQuestion+        (Delta:_)     -> seq (unsafePerformIO $ doDelta exp f)+                             repeatQuestion+        (Split:_)     -> seq (unsafePerformIO $ doDelta exp f)+                             repeatQuestion+        (Detect:_)    -> seq (unsafePerformIO $ doDetect exp f)+                             repeatQuestion+        (Explore:_)   -> seq (unsafePerformIO $ doExplore exp f)+                             repeatQuestion+--        (Observe:_)   -> seq (unsafePerformIO $ doObserve exp f)+--                             repeatQuestion+        (Trail:_)     -> seq (unsafePerformIO $ doTrail exp f)+                             repeatQuestion+        (View:_)      -> seq (unsafePerformIO $ doView exp)+                             repeatQuestion+        (ShowADT:_)   -> displayTrees width (\_ x -> x) edts+                         : repeatQuestion+        (ShowADTHs:_) -> displayTrees width+                                      (showHeuristic (heuristicValue opts kn))+                                      edts+                       : repeatQuestion+        (Children:_)  -> let+                         childQ :: ADT -> String+                         childQ (Branch _ _ f _) = f width+                         childQ (Cycle _ _) = "CYCLE!"+                       in+                         case head edts of+                           (Branch _ _ _ chldr)+                             -> if chldr == []+                                  then "No Children"+                                  else unlines $ map childQ chldr+                           (Cycle _ chldr)+                             -> unlines $ map childQ chldr+                         : repeatQuestion+        (Set var val:_) ->+          case var of+            "depthlimit" -> +              newOpts (  (DepthLimit $ read val)+                       : (filter (not . isDepthLimit) opts))+            "slicedepth" -> +              newOpts (  (SliceDepth $ read val)+                       : (filter (not . isSliceDepth) opts))+            "heuristic" ->+              newOpts (  (Heuristic $ read val)+                       : (filter (not . isHeuristic) opts))+            _            -> "Unknown variable" : repeatQuestion+        (Get var:_)   ->+          case var of+            "depthlimit" -> ("Depth Limit: " ++ show depthLimit)+                             : repeatQuestion+            "slicedepth" -> ("Slice Depth: " ++ show sliceDepth)+                             : repeatQuestion+            "heuristic"  -> ("Heuristic: " ++ show heuristic)+                             : repeatQuestion+            _            -> "Unknown variable" : repeatQuestion+        _             -> "Unknown command, type ':help' for help."+                         : repeatQuestion+    where+      edt'@(Branch _ exp' f' ch)+        = minADT opts kn $ subADTs (Just depthLimit) edts+      (DepthLimit depthLimit) = head $ filter isDepthLimit opts+      (SliceDepth sliceDepth) = head $ filter isSliceDepth opts+      (Heuristic heuristic) = head $ filter isHeuristic opts+      repeatQuestion = newOpts opts+      newOpts newOptions = mkQuestions (f,newOptions)+                                       (edts:prevADTs)+                                       (report:prevReports)+                                       (kn:prevKns)+                                       (tail ans)+      (width,_) = unsafePerformIO $ getTerminalSize+      arg :: Int -> NodeExp -> NodeExp+      arg x (NExpApp _ _ as _) = as !! x++mkQuestions (f,opts)+            (edts@(hd@(Cycle _ [Branch _ e _ _]):others):prevADTs)+            (report:prevReports)+            (kn:prevKns)+            ans+  = mkQuestions (f,opts)+                (others:edts:prevADTs)+                ((identifyBug opts+                              e ++ "\nBug in looping function.\n")+                 :report:prevReports)+                (kn:kn:prevKns)+                ans+mkQuestions (f,opts)+            (edts@(hd@(Cycle _ l:others)):prevADTs)+            (report:prevReports)+            (kn:prevKns)+            ans+  = mkQuestions (f,opts)+                (others:edts:prevADTs)+                ((identifyCycle opts l):report:prevReports)+                (kn:kn:prevKns)+                ans+mkQuestions _ _ _ _ _ = error "ADT's corrupt"++minADT :: [DeltaOption] -> DeltaKnowledge -> [ADT] -> ADT+minADT opts kn =+  minimumBy (\(Branch _ x _ _) (Branch _ y _ _)+             -> compare (heuristicValue opts kn x) (heuristicValue opts kn y))++heuristicValue :: [DeltaOption] -> DeltaKnowledge -> NodeExp -> Float+heuristicValue opts kn exp =+    if isNothing sl+      then noSliceHeuristic opts+      else let know = runs kn $ fromJust sl+           in if isNothing know+                then -(evalHeuristic mode $ (Kn (fromJust sl) 0 0))+                else -(evalHeuristic mode $ fromJust know)+    where+      sl = makeSlice sliceDepth exp+      (Heuristic mode) = head $ filter isHeuristic opts+      (SliceDepth sliceDepth) = head $ filter isSliceDepth opts++noSliceHeuristic :: [DeltaOption] -> Float+noSliceHeuristic [] = 0.0+noSliceHeuristic ((NoSliceValue x):xs) = x+noSliceHeuristic (_:xs) = noSliceHeuristic xs++evalHeuristic :: HeuristicMode -> SliceKnowledge -> Float+evalHeuristic (ValueHeuristic n) _ = n+evalHeuristic Correct know =+  (\(Kn _ _ c) -> fromIntegral c) know+evalHeuristic Incorrect know =+  (\(Kn _ w _) -> fromIntegral w) know+evalHeuristic (Add x y) know =+  evalHeuristic x know + evalHeuristic y know+evalHeuristic (Negate x) know =+  -(evalHeuristic x know)+evalHeuristic (Multiply x y) know = +  evalHeuristic x know * evalHeuristic y know+evalHeuristic (Invert x) know =+  1.0 / (evalHeuristic x know)+evalHeuristic (If c t f) know =+  if evalBool c know+    then evalHeuristic t know+    else evalHeuristic f know++evalBool :: HeuristicBool -> SliceKnowledge -> Bool+evalBool TrueBool  _  = True+evalBool FalseBool _  = False+evalBool (Not x) kn   = not (evalBool x kn)+evalBool (And x y) kn = (evalBool x kn) && (evalBool y kn)+evalBool (Or x y) kn  = (evalBool x kn) || (evalBool y kn)+evalBool (Eq x y) kn  = (evalHeuristic x kn) == (evalHeuristic y kn)+evalBool (Gt x y) kn  = (evalHeuristic x kn) > (evalHeuristic y kn)+evalBool (Lt x y) kn  = (evalHeuristic x kn) < (evalHeuristic y kn)++runs :: DeltaKnowledge -> Slice -> Maybe SliceKnowledge+runs kn@(Slices sls) =+  getRuns sls+  where+    getRuns :: [SliceKnowledge] -> Slice -> Maybe SliceKnowledge+    getRuns [] _ = Nothing+    getRuns (kn@(Kn sl _ _):others) sl'+      | sl == sl' = Just kn+      | otherwise = getRuns others sl'++removeIrrelevantQuestions :: [DeltaOption] -> ADT -> ADT+removeIrrelevantQuestions opts (Branch t n disp ch) =+  Branch t n disp newChildren+  where+    newChildren = map (removeIrrelevantQuestions opts) movedChildren+    movedChildren =+      if isNothing topLevelSlice then ch+      else foldr (++)+                 []+                 (map (findDifferentSlices (fromJust topLevelSlice)) ch)+    topLevelSlice = makeSlice sliceDepth n+    findDifferentSlices :: Slice -> ADT -> [ADT]+    findDifferentSlices sl (Branch t' n' disp' ch') =+      if not (isNothing newSlice) && fromJust newSlice == sl+        then foldr (++) [] (map (findDifferentSlices sl) ch')+        else [Branch t' n' disp' ch']+      where+        newSlice = makeSlice sliceDepth n'+    findDifferentSlices _ cycle = [cycle]+    (SliceDepth sliceDepth) = head $ filter isSliceDepth opts+removeIrrelevantQuestions opts cycle = cycle++elemBy :: a -> [a] -> (a -> a -> Bool) -> Bool+elemBy e l f = any (f e) l++deltaEval :: NodeExp -> NodeExp+deltaEval = flatEval fullEval++slices :: [DeltaOption] -> [NodeExp] -> [Slice]+slices opts =   map fromJust+              . filter (/= Nothing)+              . map (makeSlice sliceDepth)+              where+                (SliceDepth sliceDepth) = head $ filter isSliceDepth opts++makeIncorrect :: Slice -> SliceKnowledge+makeIncorrect sl = Kn sl 1 0++makeCorrect :: Slice -> SliceKnowledge+makeCorrect sl = Kn sl 0 1++compressSlices :: [SliceKnowledge] -> [SliceKnowledge]+compressSlices =+  doCompress . groupBy (\(Kn sl _ _) (Kn sl' _ _) -> sl == sl')+  where+    doCompress [] = []+    doCompress [x] = [x]+    doCompress (x@(Kn sl w c):x1@(Kn sl1 w1 c1):xs)+      | sl == sl1 = doCompress ((Kn sl (w+w1) (c+c1)):xs)+      | otherwise = x : doCompress (x1:xs)++group :: Eq a => [a] -> [a]+group = groupBy (==)++groupBy :: (a -> a -> Bool) -> [a] -> [a]+groupBy f xs+  = groupByAux f xs []+    where+      groupByAux :: (a -> a -> Bool) -> [a] -> [a] -> [a]+      groupByAux f [] res = res+      groupByAux f (x:xs) res = groupByAux f xs $ insertInto f x res+      +      insertInto :: (a -> a -> Bool) -> a -> [a] -> [a]+      insertInto f i [] = [i]+      insertInto f i (x:xs)+        | f i x     = i:x:xs+        | otherwise = x:(insertInto f i xs)+      +addSlice :: SliceKnowledge -> [SliceKnowledge] -> [SliceKnowledge]+addSlice s [] = [s]+addSlice s@(Kn sl a b) (s'@(Kn sl' a' b'):others)+  | sl == sl' = (Kn sl (a+a') (b+b')):others+  | otherwise        = s':(addSlice s others)++format :: DeltaKnowledge -> String+format (Slices slices)+  =    "Slices:\n"+    ++ unlines (map show slices)
+ tools/HatDetect.hs view
@@ -0,0 +1,51 @@+module Main where++-- System Imports+import System.IO     (stdin,stdout,stderr,hPutStrLn)+import System.Cmd    (system)+import System.Environment (getArgs,getProgName)+import System.Exit   (exitWith,ExitCode(..))+import Control.Monad (when)+import Data.List     (isSuffixOf)++import CommonUI      (Options(..),hatDetect)+import Detect        (findMain)+import LowLevel      (openHatFile)+import Foreign.C.String (withCString)++main = do args    <- System.Environment.getArgs+          prog    <- System.Environment.getProgName+          modName <- case args of+                       ("-v":_) -> do hPutStrLn stdout versionString+                                      exitWith ExitSuccess+                       (f:_)    -> return f+                       _        -> do hPutStrLn stderr (usage "no root module")+                                      exitWith (ExitFailure 1)+          withCString prog (\p-> withCString (hatFile modName) (openHatFile p))+          main <- findMain+          errCode <- system $ hatDetect (hatFile modName) main+          checkOK errCode "hat-delta"++checkOK errcode s = when (errcode/=ExitSuccess)+                         (putStrLn ("ERROR: Unable to start "++s++"."))++progName :: String+progName = "hat-detect"++version :: Float+version = 1.0++versionString :: String+versionString = progName ++ " version: " ++ (show version) ++ "\n" +++                "(c) 2005 Thomas Davie\n"++usage :: String -> String+usage err = progName ++ ": " ++ err ++ "\n" +++            "usage: " ++ progName ++ " [MODULE]\n"++hatFile :: FilePath -> FilePath+hatFile = (flip rectify) ".hat"++rectify :: FilePath -> String -> FilePath+rectify f ext | ext `isSuffixOf` f = f+              | otherwise = f ++ ext
+ tools/HatExplore.hs view
@@ -0,0 +1,1109 @@+-- module HatExplore where++import LowLevel (FileNode(..),openHatFile,nil,unevaluated,entered,interrupted+                ,NodeType(..),nodeType+                ,peekResult,peekSubExprs,peekExpArg,getParentNode+                ,hiddenChildren,getSrcRef,getDefnRef,getErrorLoc+                ,hatVersionNumber)+import qualified SrcRef (SrcRef(..))+import SrcRef (readSrcRef,defnSrcRef)+import Ident (Ident,getIdentAt)+import SExp (prettyEquation2)+import CommonUI (Options,initialOptions)+import Detect (findMain)+import CommonUI (safeReadInt,hatObserve,hatTrail,hatDetect,hatAnim)+import HighlightStyle+import System.IO (hSetBuffering,BufferMode(..),stdin,stdout,stderr,hPutStrLn)+import Foreign.C.String (withCString)+import Numeric (showHex)+import System.IO.Unsafe (unsafePerformIO)+import System.Cmd (system)+import System.Environment (getArgs,getProgName,getEnv)+import System.Exit (exitWith,ExitCode(..))+import Data.List (isSuffixOf,sortBy,partition,union)+import Control.Monad (liftM)+import Data.Char (isAlpha)+import Explore (Coord(..),noCoord,isNoCoord,isNextCoord,beforeCoord+               ,afterCoord,Row,Col+               ,Location(..),isVirtLocation,isNoLocation+               ,isImproperLocation,mkLocation,getLocation,hasUseLocation+               ,getDefLocation,getUseLocation+               ,redexParent)+++main = do+  hatFile <- initHatFile+  startNode <- determineStartNode+  startInteraction startNode +   ++printNodes :: String -> [FileNode] -> IO ()+-- for testing only+printNodes str nodes =+  putStrLn (str ++ ':' : foldr myShow "" (map int nodes))+  where+  myShow i xs = ',' : showHex i xs ++showNode :: FileNode -> String+showNode = flip showHex "" . int  +  +initHatFile :: IO FilePath+initHatFile = do+  prog    <- System.Environment.getProgName+  hatFile <- determineHatFile+  withCString prog (\p-> withCString hatFile (openHatFile p))+  return hatFile++determineHatFile :: IO FilePath+determineHatFile = do+  args    <- System.Environment.getArgs+  case args of (f:_) -> return (rectify f)+               _     -> do hPutStrLn stderr+                             ("error: no trace file")+                           exitWith (ExitFailure 1)+  where+  rectify :: FilePath -> FilePath+  rectify f | ".hat" `isSuffixOf` f = f+            | otherwise = f ++ ".hat"++dropHS :: FilePath -> FilePath+dropHS f = case reverse f of+  's':'h':'.':name -> reverse name+  's':'h':'l':'.':name -> reverse name++getErrorRedex :: IO FileNode+-- determine the redex that caused a runtime error+-- if no runtime error then return nil+getErrorRedex = do+  errRedex <- getErrorLoc -- careful, might be nil, Hidden or trusted+  return (firstWithSrcRef errRedex)++firstWithSrcRef :: FileNode -> FileNode+-- return redex or first ancestor in traced code that has source reference+-- redex may be nil, Hidden, or in trusted code (then has hidden parent)+firstWithSrcRef redex =+  if redex /= nil && (getSrcRef redex == nil || isHidden (redexParent redex))+    then firstWithSrcRef (redexParent redex)+    else redex++determineStartNode :: IO FileNode+-- either Main.main or passed as first argument+determineStartNode = do+  maybeNode <- getArgumentNode 1+  case maybeNode of+    Just node -> return node+    Nothing -> do+      errRedex <- getErrorRedex+      if errRedex /= nil then+        return errRedex+       else do+        mainNode <- findMain+        if mainNode == LowLevel.nil then do+          putStrLn "Could not find \"Main.main\"!"+          exitWith (ExitFailure 1)+         else+          return mainNode+  +getArgumentNode :: Int -> IO (Maybe FileNode)+-- get node from nth program argument, if it exists+getArgumentNode argNo = do+  arguments <- System.Environment.getArgs+  return $ if length arguments <= argNo then+             Nothing+           else case safeReadInt 0 (arguments!!argNo) of+             0 -> Nothing+             i -> let node = (FileNode i)  +                  in if expIsRedex node then Just node else +                    let parent = redexParent node+                    in if parent == nil then Nothing else Just parent+                  -- if given node is not a redex try its parent++--------------------------------------------------------------------++traverseReduct :: FileNode -> (Slice,[FileNode],[FileNode])+-- given node of redex determine+-- slice that covers part of reduct that *may* have been demanded (approxim.)+-- edt-children (demanded redexes (applications))+-- cafs (shared children)+traverseReduct redex = +  if reduct `elem` [LowLevel.nil,unevaluated,entered,interrupted] then +    (emptySlice,[],[]) +  else go reduct emptySlice+  where+  (parent,reduct) = case nodeType redex of+    ExpConstUse -> +      let constDef = peekExpArg redex 0+          constRes = peekResult constDef+      in if constRes `notElem` [nil,unevaluated,entered,interrupted]+           then case nodeType constRes of+                  ExpProjection ->+                    let projParent = getParentNode constRes +                    in if projParent /= constDef +                         then (getParentNode projParent,projParent)+                         -- pattern binding+                         else (constDef,constRes)+                  _ -> (constDef,constRes)+           else (constDef,constRes)+    _ -> (redex,peekResult redex)+  gos :: [FileNode] -> Slice -> (Slice,[FileNode],[FileNode])+  gos [] slice = (slice,[],[])+  gos (exp:exps) slice =+    let (slice1,redexes1,consts1) = gos exps slice+        (slice2,redexes2,consts2) = go exp slice1+    in (slice2,redexes2++redexes1,consts2++consts1)+  go :: FileNode -> Slice -> (Slice,[FileNode],[FileNode])+  go exp slice = if getParentNode exp /= parent then (slice,[],[]) +    else case nodeType exp of+      ExpApp -> +        if isRedex exp then+          let (newSlice,redexes,consts) = +                gos (peekSubExprs exp) (addToSlice loc slice)+          in (newSlice,exp:redexes,consts)+        else (subtractFromSlice loc slice,[],[])+      ExpValueApp -> +        gos (tail (peekSubExprs exp)) (addToSlice loc slice)+        -- first arg is atom for which there is no location+      ExpValueUse -> (addToSlice loc slice,[],[])+      ExpConstUse -> +        if isRedex (peekExpArg exp 0) then  -- check constDef+          (addToSlice loc slice,[],[exp])+        else+          (subtractFromSlice loc slice,[],[])+      ExpConstDef -> error "traverseReduct: ExpConstDef"+      ExpGuard -> +        let (slice1,redexes1,consts1) = traverseReduct exp+            (slice2,redexes2,consts2) = go (peekExpArg exp 0) slice1+        in (slice2,redexes1++redexes2,consts1++consts2)+        -- sadly trace contains no useful location for guard+        -- existing location is that of boolean expression+      ExpCase -> +        let (slice1,redexes1,consts1) = traverseReduct exp+            slice2 = addToSlice (Location{begin=begin loc+                                         ,end=Coord{row=row (begin loc)+                                              ,col = col (begin loc)+3}})+                       (mergeSlices slice1 (subtractFromSlice loc slice))+            (slice3,redexes2,consts2) = go (peekExpArg exp 0) slice2+        in (slice3,redexes1++redexes2,consts1++consts2)+        -- subtract whole subexpression from slice before adding "case"+        -- and demanded parts+      ExpIf -> +        let (slice1,redexes1,consts1) = traverseReduct exp+            slice2 = addToSlice (Location{begin=begin loc+                                         ,end=Coord{row=row (begin loc)+                                              ,col = col (begin loc)+1}})+                       (mergeSlices slice1 (subtractFromSlice loc slice))+            (slice3,redexes2,consts2) = go (peekExpArg exp 0) slice2+        in (slice3,redexes1++redexes2,consts1++consts2)+        -- subtract whole subexpression from slice before adding "if"+        -- and demanded parts+      ExpFieldUpdate -> +        if isRedex exp then+          let (slice,redexes,consts) = gos (peekSubExprs exp) +                (addToSlice loc slice)+          in (slice,exp:redexes,consts)+        else+          (subtractFromSlice loc slice,[],[])+      ExpProjection -> (addToSlice loc slice,[],[]) +        -- argument must have different parent+      ExpHidden -> (emptySlice,hiddenChildren exp,[])+        -- (slice,[],[])+      ExpForward -> go (peekResult exp) slice -- just walk through+      ExpChar -> (addToSlice loc slice,[],[])+      ExpInt -> (addToSlice loc slice,[],[])+      ExpInteger -> (addToSlice loc slice,[],[])+      ExpRat -> (addToSlice loc slice,[],[])+      ExpRational -> (addToSlice loc slice,[],[])+      ExpFloat -> (addToSlice loc slice,[],[])+      ExpDouble -> (addToSlice loc slice,[],[])+      _ -> error "getReductSubExpNodes: unexpected node type"+    where+    (_,loc) = getUseLocation exp+++isRedex :: FileNode -> Bool+-- assume there is a non-nil result +isRedex exp = peekResult exp `notElem` [unevaluated,exp]+  -- partial application can have a result pointing to itself++--------------------------------------------------------------------++redexAllChildren :: FileNode -> [FileNode]+-- given a redex, i.e. application or constUse+-- yield all children, including trusted ones+-- children are applications or constUses+redexAllChildren redex = appRedexes ++ constRedexes+  where+  (_,appRedexes,constRedexes) = traverseReduct redex++expSort :: [FileNode] -> [FileNode]+expSort = sortBy cmp+  where+  cmp red1 red2 = compare loc1 loc2+    where+    (_,loc1) = getUseLocation red1+    (_,loc2) = getUseLocation red2+++redexChildren :: FileNode -> [FileNode]+-- excludes trusted children (currently even those with children, TO DO)+-- currently this function is not used at all+redexChildren = filter suspectedRedex . redexAllChildren+++suspectedRedex :: FileNode -> Bool+-- given application or constUse+suspectedRedex redex = +  result `elem` [entered,interrupted] || +    not (isHidden result && null (hiddenChildren result)) +  where+  result = redexResult redex++redexResult :: FileNode -> FileNode+-- given application or constUse return the reduct (or entered, etc)+-- this is usually not the final result+redexResult redex = case nodeType redex of+  ExpApp -> peekResult redex+  ExpConstUse -> peekResult (peekExpArg redex 0)+  ExpConstDef -> peekResult redex+  -- the following are just for reliablity+  ExpGuard -> peekResult redex+  ExpCase -> peekResult redex+  ExpIf -> peekResult redex+  ExpFieldUpdate -> peekResult redex+  _ -> error ("redexResult: unexpected redex " ++ showNode redex)++redexParents :: FileNode -> [FileNode]+-- list of ancestors, first is the parent+redexParents redex =+  let parent = redexParent redex+  in if parent == nil then [] else parent : redexParents parent++expIsRedex :: FileNode -> Bool+expIsRedex node = case nodeType node of+  ExpApp -> isRedex node+  ExpConstUse -> isRedex (peekExpArg node 0)+  ExpConstDef -> isRedex node+  _ -> False++isHidden :: FileNode -> Bool+isHidden node = case nodeType node of+  ExpHidden -> True+  _         -> False++--------------------------------------------------------------------++updRedexFaultyDescendants :: State -> State+-- all descendants including redex itself that may be faulty+-- i.e. descendant tree without subtrees started by a correct redex+updRedexFaultyDescendants state =+  state{faultSetRoot = root+       ,faultSet = if root == nil then emptySet else go root id emptySet}+  where+  -- root is first wrong redex when going up parents+  root = case filter (`elemSet` (wrong state)) +                (cur (redexes state):parents state) of+           (wrong:_) -> wrong+           [] -> nil+  -- continuation passing style, threading already visited nodes+  -- to avoid looping for mutually recursive constants+  go :: FileNode -> (Set FileNode -> Set FileNode) +     -> Set FileNode -> Set FileNode+  go redex cont collected =+    if redexCorrect redex state || redex `elemSet` collected+      then cont collected+      else (foldr ($) cont (map go (redexAllChildren redex))) +             (insertSet redex collected)+++--------------------------------------------------------------------++redexDefUsedSlice :: State -> FileNode -> Slice+redexDefUsedSlice state redex =+  let (file,loc) = getDefLocation redex+  in if file /= filename (cur (modules state))+       then emptySlice+       else used+  where+  (used,_,_) = traverseReduct redex++redexDefSlice :: State -> FileNode -> Slice+redexDefSlice state redex =+  let (file,loc) = getDefLocation redex+  in if file == filename (cur (modules state))+       then mkSlice loc+       else emptySlice++redexUseLocation :: FileNode -> Location+-- assumes given node is redex, i.e. application or constUse+-- location covers full redex, including all subexpressions+redexUseLocation redex =+  if redex `elem` [nil,unevaluated,entered,interrupted] then+    error "redexUseLocation: invalid redex"+  else loc+  where+  (_,loc) = getUseLocation redex++redexUseSlice :: FileNode -> Slice+-- assumes given node is redex, i.e. application or constUse+-- slice includes the application and all subconstructs +-- that are values or may be values+redexUseSlice redex = +  if redex `elem` [nil,unevaluated,entered,interrupted] then+    error "redexUseSlice: invalid redex"+  else gos (peekSubExprs redex) (mkSlice loc)+  where+  parent = getParentNode redex+  (_,loc) = getUseLocation redex++  gos :: [FileNode] -> Slice -> Slice+  gos exps slice = foldr go slice exps+  go :: FileNode -> Slice -> Slice+  go exp slice = +    if getParentNode exp /= parent then +      slice+    else case nodeType exp of+      ExpApp -> subtractFromSlice loc slice+      ExpValueApp -> gos (tail (peekSubExprs exp)) (addToSlice loc slice)+      ExpValueUse -> addToSlice loc slice+      ExpConstUse -> subtractFromSlice loc slice+      ExpConstDef -> slice -- only if original redex was constUse+      ExpGuard -> subtractFromSlice loc slice+      ExpCase -> subtractFromSlice loc slice+      ExpIf -> subtractFromSlice loc slice+      ExpFieldUpdate -> subtractFromSlice loc slice+      ExpChar -> addToSlice loc slice+      ExpInt -> addToSlice loc slice+      ExpInteger -> addToSlice loc slice+      ExpRat -> addToSlice loc slice+      ExpRational -> addToSlice loc slice+      ExpFloat -> addToSlice loc slice+      ExpDouble -> addToSlice loc slice+      _ -> error "redexUseSlice: unexpected node type"+    where+    (_,loc) = getUseLocation exp++--------------------------------------------------------------------++borderSlice :: Text -> Slice+-- construct slice of all spaces at beginning and ends of lines+borderSlice text = Slice (go 1 text)+  where+  go :: Int -> Text -> [Location]+  go _ [] = []+  go curRow (line:rest) = +    (if leftSpace > 0 then +       (Location{begin=Coord{row=curRow,col=1}+                ,end=Coord{row=curRow,col=leftSpace}}:)+     else id)+    ((Location{begin=Coord{row=curRow,col=lastCol-rightSpace+1}+              ,end=Coord{row=curRow,col=maxBound}}:)+    (go (curRow+1) rest))+    where+    lastCol = length revLine+    leftSpace = length (takeWhile (==' ') line)+    rightSpace = length (takeWhile (==' ') revLine)+    revLine = case reverse line of+                '\r':rest -> rest+                all -> all++--------------------------------------------------------------------++startInteraction :: FileNode -> IO ()+startInteraction startRedex = do+  hSetBuffering stdin NoBuffering+  hSetBuffering stdout NoBuffering+  (width,height) <- getTerminalSize+  putStr cls+  let allParents = redexParents startRedex+  current <- loadModule (fst (getLocation startRedex))+  curModules <- insertModules allParents (mkCursorSeq [] current [])+  checkModules (newRedex (State+    { modules = curModules+    , window = Coord{row=height,col=width}+    , firstRow = 1+    , parents = allParents+    , redexes = undefined+    , correct = emptySet+    , wrong = emptySet+    , neither = emptySet+    , faultSetRoot = nil+    , faultSet = emptySet+    , showFaultSet = False+    , showPart = False+    , message = "Press h for help."+    })+    startRedex)+++fileTags :: State -> [Tag]+fileTags state = +  let redexSlice = mkSlice (redexUseLocation (cur (redexes state)))+      siblings = cursorSeqToList (redexes state)+      (suspectedSiblings,trustedSiblings) = partition suspectedRedex siblings+      (correctSus,otherSus) = +        partition (`elemSet` (correct state)) suspectedSiblings+      (wrongFaultySus,neitherSus) =+        partition (`elemSet` (wrong state)) otherSus+      (neitherTrust,otherTrust) =+        partition (`elemSet` (neither state)) trustedSiblings+      (wrongFaultyTrust,correctTrust) =+        partition (`elemSet` (wrong state)) trustedSiblings+      correctSiblings = correctTrust ++ correctSus+      neitherSiblings = neitherTrust ++ neitherSus+      (faultySiblings,wrongSiblings) = +        partition (`redexFaulty` state) (wrongFaultyTrust ++ wrongFaultySus)+      correctSiblingsSlice = mergeSlicesMap redexUseSlice correctSiblings+      neitherSiblingsSlice = mergeSlicesMap redexUseSlice neitherSiblings+      wrongSiblingsSlice = mergeSlicesMap redexUseSlice wrongSiblings+      faultySiblingsSlice = mergeSlicesMap redexUseSlice faultySiblings+      makeSlice = if showPart state then redexDefUsedSlice else redexDefSlice+  in if filename (cur (modules state)) == +        fst (getUseLocation (cur (redexes state)))+       then combineSlices +               [(redexSlice,currentM)+               ,(correctSiblingsSlice,correctM)+               ,(wrongSiblingsSlice,wrongM)+               ,(neitherSiblingsSlice,markedM)+               ,(faultySiblingsSlice,faultyM)+               ,(border (cur (modules state)),emptyM)+               ,(if showFaultSet state+                   then manySlices (makeSlice state) (faultSet state)+                   else makeSlice state (cur (redexes state))+                ,definitionM)]+       else case getLocation (cur (redexes state)) of+              (file,loc) ->             +                combineSlices+                  ((if file == filename (cur (modules state))+                     then ((mkSlice loc,currentM):)+                     else id)+                  [(border (cur (modules state)),emptyM)+                  ,(if showFaultSet state+                      then manySlices (makeSlice state) (faultSet state)+                      else makeSlice state (cur (redexes state))+                   ,definitionM)])+    ++redexMark :: FileNode -> State -> Mark+redexMark red state =+  (if showFaultSet state  && red == faultSetRoot state+     then (combMarks definitionM) else id) $+  (if red == cur (redexes state) then (combMarks currentM) else id) $+  (if red `elemSet` correct state +     then correctM+   else if red `elemSet` wrong state +     then if redexFaulty red state then faultyM else wrongM+   else if red `elemSet` neither state || suspectedRedex red+     then markedM+   else correctM)     ++equationText :: State -> Int -> FileNode -> String+equationText state no eqn = +  leftWidth 2 (show no) ++ ". " ++ mark2Highlights (redexMark eqn state) +++    take (col (window state)-5) +       (removeHighlights (prettyEquation2 initialOptions eqn))+    ++ highlightOff+  -- need to remove highlights in equation, because otherwise+  -- highlights not correctly nested and line cut off too early++leftWidth width = reverse . take width . (++ repeat ' ') . reverse++removeHighlights :: String -> String+removeHighlights xs = ys ++ +  if null zs then [] else (removeHighlights . tail . dropWhile (/= 'm')) zs+  where+  (ys,zs) = span (/= '\ESC') xs++defaultMessage :: State -> String+defaultMessage state =+  "Call " ++ show (curIndex (redexes state)) ++ +  "/" ++ show (lengthCursorSeq (redexes state)) ++ " | " +++  (if showFaultSet state then "faulty slice" else "definition") ++ " | " +++  (if showPart state then "executed part" +                     else "complete")+++force :: [a] -> [a]+-- force evaluation of whole list spine+force = reverse . reverse++cutOffText :: Int -> Text -> String+-- cut off text at given width, handling embedded escape sequences correctly+-- (not all, e.g. not goto)+-- also does not cut off escape sequences appearing just after width+-- incomplete lines are filled up with spaces+cutOffText mw = init . unlines . (map (cutOffLine mw))+  where+  cutOffLine :: Int -> String -> String+  cutOffLine w xs = case xs of+    "" -> replicate w ' '+    (c:cs) -> if c == '\ESC' +                then let (escapeSeq,end:rest) = break isAlpha cs+                     in c : escapeSeq++[end]++cutOffLine w rest +              else if w == 0 +                then highlightOff+              else c : cutOffLine (w-1) cs++display :: State -> IO ()+display state = do+  let lastRow = firstRow state + row (window state) - srcRow - 1+      tags = fileTags state+      markedText = markText (text (cur (modules state))) (firstRow state) +                     lastRow tags+      eqns = reverse (cur (redexes state) : take (eqnNo-1) (parents state))+      firstEqnNo = length (parents state)-length eqns+2+  putStr (home ++ lineWrap False)+  writeFile "test.txt" (show tags)+  (putStr . force . cutOffText (col (window state))) $ +    -- force minimises flickering of screen output+    highlight [Bold] ("==== Hat-Explore " ++ hatVersionNumber ++ " ==== "+       ++ (if null (message state) then defaultMessage state +                                   else message state)+       ++ ' ':repeat '=')+    : zipWith (equationText state) [firstEqnNo..] eqns +    ++ replicate (eqnNo - length eqns) ""+    ++ highlight [Bold] ("---- "++filename (cur (modules state))+      ++" ---- lines "++show (firstRow state)++" to "+      ++show lastRow++' ':repeat '-') +    : markedText +  putStr home++data SrcModule = SrcModule+  { filename :: String+  , text :: Text+  , len :: Row+  , border :: Slice+  }++eqnNo = 5 :: Int+srcRow = eqnNo+2 :: Int+srcRows state = row (window state) - srcRow++data State = State +  { modules :: CursorSeq SrcModule  -- ordered alphabetically+  , window :: Coord+  , firstRow :: Row+  , parents :: [FileNode] -- ancestors of redexes+  , redexes :: CursorSeq FileNode +      -- current redex + siblings ordered by location+  , correct :: Set FileNode -- trusted ones not listed+  , wrong :: Set FileNode+  , neither :: Set FileNode -- subset of trusted ones+  , faultSetRoot :: FileNode+  , faultSet :: Set FileNode+  , showFaultSet :: Bool+  , showPart :: Bool+  , message :: String+  }++newRedex :: State -> FileNode -> State+-- set given redex in state; assume parents are already set correctly+-- note: a parent might be a pseudo-parent of a constant+newRedex state new = +  case parents state of+    (parent:_) -> let parChildren = expSort (redexAllChildren parent)+                      (left,rest) = break (== new) parChildren+                  in if null rest -- redex not amongst children of parent+                    then state{redexes = mkCursorSeq [] new []}+                    else state{redexes = mkCursorSeq left new (tail rest)}+    [] -> state{redexes = mkCursorSeq [] new []}++help :: IO ()+help = do+  putStr (cls ++ goto 1 1)+  putStr (highlight [Bold] "==== Help Text ===============================")+  putStr (goto 1 2)+  putStr helpText+  getChar+  return ()+  where+  helpText = " cursor down    follow current call\n cursor up      go back to caller of current call\n cursor left    go to call further left in current definition body\n cursor right   go to call further right in current definition body\n\n c              declare current equation to be correct (wrt. intentions)\n w              declare current equation to be wrong (wrt. intentions)\n n              undo declaration of correctness (neither correct nor wrong)\n a              amnesia - forget all declarations as correct or wrong\n\n f              toggle between showing fault set or just current definition\n p              toggle between showing used part of definition or full\n\n <              change to alphabetically preceeding module\n >              change to alphabetically succeeding module\n\n t              scroll source window to top of code\n u              scroll source window upwards\n d              scroll source window downwards\n b              scroll source window to bottom of code\n\n r              redraw everything after change of window size\n h or ?         display this help text\n\n q              quit\n\n\nMeaning of colours:\ngreen - correct, amber - wrong, blue - unkown, red - faulty.\n\n Press any key to continue. "++loop :: State -> IO ()+loop state1 = do+  let state2 = updRedexFaultyDescendants state1+  display state2+  let state = state2{message = ""}+  c <- getChar+  case c of +    'q' -> putStr cls+    'u' -> let oldRow = firstRow state+           in loop state{firstRow = if oldRow>1 then oldRow-1 else oldRow}+    'd' -> let oldRow = firstRow state+           in loop state{firstRow = if oldRow<=len (cur (modules state)) +                                      then oldRow+1 +                                      else oldRow}+    't' -> loop state{firstRow = 1}+    'b' -> loop state{firstRow = max 1 +                                   (len (cur (modules state))+                                    -(row (window state))+2)}+    'r' -> do   +             (width,height) <- getTerminalSize+             loop state{window=Coord{row=height,col=width}}+    'c' -> loop (declareCorrect state) +    'w' -> loop (declareWrong state)+    'n' -> loop (declareNeither state)+    'a' -> loop state{correct=emptySet,wrong=emptySet,neither=emptySet}+    'f' -> loop state{showFaultSet=not (showFaultSet state)}+    'p' -> loop state{showPart = not (showPart state)}+    '<' -> if lengthCursorSeq (modules state) == 1+             then loop state{message = "There is only one module."}+             else loop state{modules = rotateLeft (modules state)}+    '>' -> if lengthCursorSeq (modules state) == 1+             then loop state{message = "There is only one module."}+             else loop state{modules = rotateRight (modules state)}+    'o' -> do+             System.Cmd.system (hatObserve +               (dropHS (filename (cur (modules state))))+               (head (words (removeHighlights  -- crude approximation+                 (prettyEquation2 initialOptions (cur (redexes state)))))))+             loop state{message = "Spawned hat-observe"}+    'l' -> do +             System.Cmd.system (hatTrail (dropHS (filename (cur (modules state)))) +               (cur (redexes state)))+             loop state{message = "Spawned hat-trail"}+    'e' -> do +             System.Cmd.system (hatDetect+               (dropHS (filename (cur (modules state))))+               (cur (redexes state)))+             loop state{message = "Spawned hat-detect"}+    'i' -> do +             System.Cmd.system (hatAnim (dropHS (filename (cur (modules state)))) +               (cur (redexes state)))+             loop state{message = "Spawned hat-anim"}+    'h' -> help >> loop state+    '?' -> help >> loop state+    '\ESC' -> do+      c <- getChar+      if c `elem` "[O" then do+        c <- getChar+        case c of+          'D' -> -- cursor left+                 if lengthCursorSeq (redexes state) == 1+                   then loop state{message = "The call has no siblings."}+                   else loop state{redexes = rotateLeft (redexes state)}+          'C' -> -- cursor right+                 if lengthCursorSeq (redexes state) == 1+                   then loop state{message = "The call has no siblings."}+                   else loop state{redexes = rotateRight (redexes state)}+          'A' -> -- cursor up+                 if not (null (parents state)) then checkModules+                   (newRedex state{parents = tail (parents state)} +                      (head (parents state)))+                 else loop state{message = +                      "This is a top-level constant whose caller is unknown."}+          'B' -> -- cursor down+                 -- TO DO: handle constDef differently+                 case expSort (redexAllChildren (cur (redexes state))) of+                   (child:_) -> +                     checkModules (newRedex +                       state{parents = cur (redexes state) : parents state} +                       child)+                   [] -> loop state{message = "There are no child calls."}+       else loop state{message = "Unkown command. Press h for help."}+    _   -> loop state{message = "Unkown command. Press h for help."}++loadModule :: FilePath -> IO SrcModule+loadModule filename = do+  filecontent <- readFile filename+  let srcText = lines (expandTabs 0 filecontent)+  return (SrcModule +           { filename = filename+           , text = srcText+           , len = length srcText+           , border = borderSlice srcText})++expandTabs :: Col -> String -> String+expandTabs _ "" = ""+expandTabs c (x:xs) = case x of+  '\t' -> replicate spaces ' ' ++  expandTabs (c+spaces) xs+  '\n' -> '\n' : expandTabs 0 xs+  '\r' -> expandTabs 0 xs+  '\v' -> '\n' : expandTabs 0 xs +  _    -> x : (expandTabs $! (c+1)) xs +  where+  spaces = 8 - c `mod` 8++checkModules :: State -> IO ()+-- called after redex was changed+-- ensure that module of redex use is loaded and becomes current Module+checkModules state = do+  newModules <- insertModule (cur (redexes state)) (modules state)+  loop (checkRow state{modules = newModules})++insertModules :: [FileNode] -> CursorSeq SrcModule -> IO (CursorSeq SrcModule)+insertModules [] modules = return modules+insertModules (n:ns) modules = do+  modules2 <- insertModule n modules+  insertModules ns modules2++insertModule :: FileNode -> CursorSeq SrcModule -> IO (CursorSeq SrcModule)+-- ensure that module of given node is loaded and becomes current one+insertModule node oldModules =+  let curFilename = fst (getLocation node) +  in case selectCurrent ((== curFilename) . filename) oldModules of+       Just newModules -> return newModules+       Nothing -> do+         current <- loadModule curFilename+         return (insertNewCurrent +                  ((< curFilename) . filename) current oldModules)++checkRow :: State -> State+-- insure that redex use (or def if no use) is within the displayed window+checkRow state = +  if firstInter >= firstRow state &&+     lastInter < firstRow state + rows +    then state+  else if modLen <= rows+    then state{firstRow = 1}+  else if lastInter - firstInter >= rows+    then state{firstRow = firstInter}+  else let start = firstInter - (rows - (lastInter-firstInter+1)) `div` 2+       in if start + rows -1 > modLen+            then state{firstRow = modLen - rows + 1}+          else if start < 1 +            then state{firstRow = 1}+          else state{firstRow = start}+  where+  rows = srcRows state+  modLen = len (cur (modules state))+  (firstInter,lastInter) = rowsOfInterest state++rowsOfInterest :: State -> (Row,Row)+rowsOfInterest state =+  if hasUseLocation (cur (redexes state)) +    then (row (begin (head siblingLocations))+         ,row (end (last siblingLocations)))+    else (row (begin curLoc),row (end curLoc))+  where+  (_,curLoc) = getLocation (cur (redexes state))+  Slice siblingLocations =+    foldr mergeSlices emptySlice +      (map redexUseSlice +        (cursorSeqToList (redexes state)))++declareCorrect :: State -> State+declareCorrect state@State{correct=cor,wrong=wr,neither=nei} = +  let red = cur (redexes state)+  in state{correct = if suspectedRedex red then insertSet red cor else cor+          ,wrong = removeSet red wr+          ,neither = removeSet red nei}++declareWrong :: State -> State+declareWrong state@State{correct=cor,wrong=wr,neither=nei} = +  let red = cur (redexes state)+  in state{correct = removeSet red cor+          ,wrong = insertSet red wr+          ,neither = removeSet red nei}+ +declareNeither :: State -> State+declareNeither  state@State{correct=cor,wrong=wr,neither=nei} = +  let red = cur (redexes state)+  in state{correct = removeSet red cor+          ,wrong = removeSet red wr+          ,neither = if suspectedRedex red then nei else insertSet red nei}++redexFaulty :: FileNode -> State -> Bool+-- cannot otherwise keep track of faulty redexes, because don't know+-- pseudoparents of a constant.+redexFaulty red state =+  red `elemSet` (wrong state) && +    all (flip redexCorrect state) (redexAllChildren red)++redexCorrect :: FileNode -> State -> Bool+redexCorrect red state =+  red `elemSet` correct state || +  not (suspectedRedex red || red `elemSet` neither state || +       red `elemSet` wrong state)++-----------------------------++type Text = [String] -- list of tab and newline-free lines; 1 char = 1 col+type MarkedText = [String] -- may include escape sequences for highlighting+++mark2Highlights :: Mark -> String+mark2Highlights Empty = highlightOn [Normal] -- default marking+mark2Highlights (Mark hi1 hi2 ) = +  highlightOn (Normal : hi1 ++ hi2)+  -- the foreground colour is never changed+  -- this may be problematic if default foreground does not contrast with+  -- the various background colours chosen here+  -- however, some terminals (e.g. kde) interpret bold + foreground colour+  -- as a lighter foreground colour; so to obtain bold plus background colour+  -- also on these terminals, the foreground is never changed.+++markText :: Text -> Row -> Row -> [Tag] -> MarkedText+-- markup input text from first row up to second row+-- result only contains the specified rows+-- filled up with empty rows if necessary+-- assumes at least first row and rows mentioned in tags exist in text+markText text beginRow endRow tags =+  markTextTo startText startTags endRow+  where+  startText = drop (beginRow-1) text+  startTags = getTagsFromRow tags beginRow +++markTextTo :: Text -> [Tag] -> Row -> MarkedText+-- assumes that coords of first tag are coords of first text char+markTextTo text (t:ts) lastRow = +  (mark2Highlights (mark t)++line):lines+  where+  (line:lines) = go text (start t) ts+  go :: Text -> Coord -> [Tag] -> MarkedText+  go (line:lines) current (t:ts) =+    if row (start t) > lastRow then+      copyLastLines (line:lines) (row current)+    else if row (start t) == row current then+      let (firstLine,restLine) = +            splitAt (col (start t) - col current) line+          (mRestLine:mRest) = go (restLine:lines) (start t) ts+      in (firstLine ++ mark2Highlights (mark t) ++ mRestLine)+         : mRest+    else -- row (start t) > row current +      line : go lines Coord{row = row current+1,col = 1} (t:ts)+  go lines current _ = -- either no lines or no tags+    copyLastLines lines (row current)+  copyLastLines :: Text -> Row -> MarkedText+  copyLastLines (line:lines) currentRow =+    if currentRow < lastRow then+      line : copyLastLines lines (currentRow+1)+    else -- currentRow == lastRow+      [line ++ highlightOff]+  copyLastLines [] currentRow = +    replicate (lastRow-currentRow-1) [] ++ [highlightOff]+++splitText :: Text -> Coord -> Coord -> (Text,Text)+-- all texts start and end with incomplete rows+splitText (line:lines) first second =+  if row first == row second then+    let (firstLine,restLine) = splitAt (col second - col first) line+    in ([firstLine],restLine:lines)+  else -- row first < row second+    let (firstText,secondText) = splitText lines Coord{row = row first+1,col = 1} second+    in (line:firstText,secondText)+    +++getTagsFromRow :: [Tag] -> Row -> [Tag]+-- first tag starts at beginning of the row+getTagsFromRow tags first = go tags noneM+  where+  go [] m = [Tag{start=Coord{row=first,col=1},mark=m}]+  go (t:ts) m = case compare (row (start t)) first of+    LT -> go ts (mark t)+    EQ -> if col (start t) == 1 then t:ts+          else+            Tag{start=Coord{row=first,col=1},mark=m}:t:ts+    GT -> Tag{start=Coord{row=first,col=1},mark=m}:t:ts+   ++data Mark = Empty | Mark [Highlight] [Highlight] deriving Show -- TESTING+  -- second (possibly) contains background colour+  -- first contains all other highlighting+  -- they are separate to simplify combination (does it??)++emptyM = Empty+currentM = Mark [Underscore,Bold] []+markedM = Mark [] [Background Cyan]+correctM = Mark [] [Background Green]+wrongM = Mark [] [Background Yellow]+faultyM = Mark [] [Background Red]+definitionM = Mark [Bold] []+noneM = Mark [] []++combMarks :: Mark -> Mark -> Mark+combMarks Empty _ = Empty+combMarks _ Empty = Empty+combMarks (Mark hi11 hi12) (Mark hi21 hi22) = +  Mark (hi11 `union` hi21) (hi12 `union` hi22)++data Tag = Tag {start :: Coord, mark :: Mark} deriving Show -- TESTING++combineSlices :: [(Slice,Mark)] -> [Tag]+combineSlices = foldr1 combTags . map (uncurry slice2Tags)+++slice2Tags :: Slice -> Mark -> [Tag]+slice2Tags slice m = enter (unSlice slice)+  where+  enter :: [Location] -> [Tag]+  enter [] = []+  enter (l:ls) = if end l < begin l+                   then enter ls +                   else Tag{start = begin l, mark = m} : exit (l:ls)+  exit :: [Location] -> [Tag]+  exit (l:ls) = Tag{start= afterCoord (end l), mark = noneM} : enter ls++combTags :: [Tag] -> [Tag] -> [Tag]+combTags t1s t2s = go noneM t1s noneM t2s+  where+  go :: Mark -> [Tag] -> Mark -> [Tag] -> [Tag]+  -- keep track of current mark for each tag sequence+  go m1 [] _ ts = map (\t -> t{mark = combMarks m1 (mark t)}) ts+  go _ ts m2 [] = map (\t -> t{mark = combMarks m2 (mark t)}) ts+  go m1 (t1:t1s) m2 (t2:t2s) = case compare (start t1) (start t2) of+    LT -> Tag{start = start t1, mark = combMarks (mark t1) m2} +          : go (mark t1) t1s m2 (t2:t2s)+    GT -> Tag{start = start t2, mark = combMarks (mark t2) m1} +          : go m1 (t1:t1s) (mark t2) t2s +    EQ -> Tag{start = start t1, mark = combMarks (mark t1) (mark t2)}+          : go (mark t1) t1s (mark t2) t2s+++-------------------------------------------------------++++newtype Slice = Slice {unSlice :: [Location]} +  -- proper locations, non-overlapping and ordered++compressSlice :: Slice -> Slice+compressSlice (Slice []) = Slice []+compressSlice (Slice [l]) = Slice [l]+compressSlice (Slice (l1:l2:ls)) =+  if isNextCoord (end l1) (begin l2) then+    compressSlice (Slice (Location{begin = begin l1, end = end l2}:ls))+  else+    Slice (l1 : unSlice (compressSlice (Slice (l2:ls))))++mergeSlices :: Slice -> Slice -> Slice+-- additive combination of two slices+mergeSlices rs (Slice []) = rs+mergeSlices (Slice []) rs = rs+mergeSlices (Slice (l1:l1s)) (Slice (l2:l2s)) =+  if end l1 < begin l2 then  -- location 1 before location 2+    Slice (l1 : (unSlice (mergeSlices (Slice l1s) (Slice (l2:l2s)))))+  else if end l2 < begin l1 then  -- location 2 before location 1+    Slice (l2 : (unSlice (mergeSlices (Slice (l1:l1s)) (Slice l2s))))+  else if end l1 < end l2 then+    mergeSlices +      (Slice l1s) +      (Slice (Location{begin = min (begin l1) (begin l2),end = end l2} : l2s))+  else -- end l2 <= end l1+    mergeSlices +      (Slice (Location{begin = min (begin l1) (begin l2),end = end l1} : l1s))+      (Slice l2s)++addToSlice :: Location -> Slice -> Slice+-- maybe a more efficient implementation will be done later+addToSlice loc = mergeSlices (Slice [loc])++subtractFromSlice :: Location -> Slice -> Slice+-- given location must be improper or +-- nested in one of the locations of the slice+-- or be outside any locations of the slice; no overlap+subtractFromSlice l (Slice []) = emptySlice+subtractFromSlice l1 (Slice (l2:ls)) =+  if isImproperLocation l1 then+    Slice (l2:ls)+  else if begin l1 > end l2 then -- l1 not nested in l2+    Slice (l2 : unSlice (subtractFromSlice l1 (Slice ls)))+  else -- from assumption of nesting follows that l1 nested in l2+    if begin l1 == begin l2 then+      if end l1 == end l2 then+        Slice ls+      else+        Slice (Location{begin=afterCoord (end l1),end=end l2} : ls)+    else+      if end l1 == end l2 then+        Slice (Location{begin=begin l2,end=beforeCoord (begin l1)} : ls)+      else+        Slice (Location{begin=begin l2,end=beforeCoord (begin l1)} :+               Location{begin=afterCoord (end l1),end=end l2} : ls)+  +mergeSlicesMap :: (a -> Slice) -> [a] -> Slice+mergeSlicesMap f ns = foldr mergeSlices emptySlice (map f ns)++manySlices :: (FileNode -> Slice) -> Set FileNode -> Slice+manySlices f set = foldr mergeSlices emptySlice (map f (deSet set))++emptySlice :: Slice+emptySlice = Slice []++mkSlice :: Location -> Slice+mkSlice l = if isVirtLocation l || isNoLocation l then Slice [] else Slice [l]+++-------------------------------------------------------------------+-- abstract data type ordered sequence of elements with one current element++data CursorSeq a = CursorSeq {cur :: a, left :: [a], right :: [a]}+-- describes sequence with elements ordered as follows:+-- reverse left ++ cur : right+-- with one element marked as current element++lengthCursorSeq :: CursorSeq a -> Int+lengthCursorSeq cs = 1 + length (left cs) + length (right cs)++cursorSeqToList :: CursorSeq a -> [a]+cursorSeqToList cs = reverse (left cs) ++ cur cs : right cs++mkCursorSeq :: [a] -> a -> [a] -> CursorSeq a+mkCursorSeq l c r = CursorSeq{cur = c, left = reverse l, right = r}++insertNewCurrent :: (a -> Bool) -> a -> CursorSeq a -> CursorSeq a+-- predicate is true for all smaller elements+insertNewCurrent p c cs = let+  elements = reverse (left cs) ++ cur cs : right cs+  (l,r) = span p elements+  in mkCursorSeq l c r++curIndex :: CursorSeq a -> Int+curIndex cs = length (left cs) + 1++selectCurrent :: (a -> Bool) -> CursorSeq a -> Maybe (CursorSeq a)+-- may not find element fulfilling predicate+selectCurrent p cs = let+  elements = reverse (left cs) ++ cur cs : right cs+  (l,r) = break p elements+  in case r of+       [] -> Nothing+       (c:r') -> Just (mkCursorSeq l c r')++rotateLeft :: CursorSeq a -> CursorSeq a+-- jumps at end+rotateLeft cs = let l = left cs in+  if null l +    then if null (right cs)+           then cs+           else let r = reverse (cur cs:right cs) in+             CursorSeq{cur = head r, left = tail r, right = []}+    else CursorSeq{cur = head l, left = tail l, right = cur cs:right cs} ++rotateRight :: CursorSeq a -> CursorSeq a+-- jumps at end+rotateRight cs = let r = right cs in+  if null r+    then if null (left cs)+           then cs+           else let l = reverse (cur cs:left cs) in+             CursorSeq{cur = head l, left = [], right = tail l}+    else CursorSeq{cur = head r, left = cur cs:left cs, right = tail r}++-------------------------------------------------------------------+-- abstract data type set++newtype Set a = Set {deSet :: [a]}++emptySet :: Set a+emptySet = Set []++insertSet :: Eq a => a -> Set a -> Set a+insertSet x set = if x `elemSet` set then set else Set (x: deSet set)++elemSet :: Eq a => a -> Set a -> Bool+elemSet x set = x `elem` deSet set++removeSet :: Eq a => a -> Set a -> Set a+removeSet x set = Set [y | y <- deSet set, y /= x]++subSet :: Eq a => Set a -> Set a -> Bool+subSet s1 s2 = all (`elemSet` s2) (deSet s1)++unionSet :: Eq a => Set a -> Set a -> Set a+unionSet s1 s2 = foldr insertSet s2 (deSet s1)++-------------------------------------------------------------------
+ tools/HatMake.hs view
@@ -0,0 +1,92 @@+-- Simple 'make' for tracing+-- only works with ghc+-- authors: Neil Mitchel, Olaf Chitil+module Main where++import System.Environment (getArgs)+import System.Cmd (system)+import System.Exit (ExitCode(..), exitFailure)+import Data.List (nub, partition, isPrefixOf, intersperse, concat)+import Data.Char (isSpace)+import System.Directory (doesFileExist, findExecutable)+import Control.Monad (when)+++main = do x <- getArgs+          Just hatPath <- findExecutable "hat-make"+          let hatFolder = dropFilename hatPath+          when (null x) (error "Please give the name of the file to hat-make on the command line")+          let opts = init x+          let optStr = concat (intersperse " " opts)+          let y = last x+          systemTry $ "ghc -M -dep-makefile .depend " ++ y ++ " " ++ optStr+          mak <- readFile ".depend"+          let (files,depends) = parseMakefile mak+          translate hatFolder files depends+          compileAll hatFolder optStr y++dropFilename x = reverse $ dropWhile (\x -> not $ x `elem` "\\/") $ reverse x+++parseMakefile :: String -> ([String], [(String, String)])+parseMakefile src =+        (+            nub $ concat [[a,b] | (a,b) <- res]+            ,+            nub $ [(a,b) | (a,b) <- res, a /= b]+        )+    where+        res = concatMap f $ lines src+    +        f :: String -> [(String, String)]+        f ('#':_) = []+        f x = [(filename a, filename b)]+            where (a,_:b) = break (== ':') x++filename x = reverse $ tail $ dropWhile (/= '.') $ reverse $ filter (not . isSpace) x+++translate :: String -> [String] -> [(String, String)] -> IO ()+translate hatFolder files deps =+        if null files then return ()+        else if null yes then error "Circular dependancies"+        else mapM_ (translateFile hatFolder) yes >> translate hatFolder no newdeps+    where+        newdeps = [(a,b) | (a,b) <- deps, not (b `elem` yes)]+        (yes,no) = partition isDoable files+        isDoable x = not $ any ((==) x . fst) deps+++translateFile :: String -> FilePath -> IO ()+translateFile hatFolder file = do+    fil <- pickFile file+    putStrLn $ "Converting with Hat, " ++ fil+    systemTry $ "hat-trans " ++ fil+++pickFile :: FilePath -> IO FilePath+pickFile x = do hs  <- doesFileExist (x++".hs")+                lhs <- doesFileExist (x++".lhs")+                return $ if lhs then x ++ ".lhs" else x ++ ".hs"++compileAll :: String -> String -> String -> IO ()+compileAll hatFolder optStr file = do+    putStrLn "Compiling with GHC..."+    systemTry $ "ghc --make Hat/" ++ file ++ " " ++ optStr+                    -- " -ffi -fglasgow-exts -cpp -i.;" +++                    -- hatFolder ++ "/hs " +++                    -- hatFolder ++ "/c/hat-c.o " +++                    -- hatFolder ++ "/c/ntohl.o"++systemTry :: String -> IO ()+systemTry x = do putStrLn x+                 y <- system x+                 when (y /= ExitSuccess) exitFailure+++prettyFile :: FilePath -> FilePath+prettyFile x = x  -- for Unix+-- prettyFile x = map g (if "./" `isPrefixOf` x then drop 2 x else x)+--     where+--        g '/' = '\\'+--        g x = x
+ tools/HatNonTerm.hs view
@@ -0,0 +1,241 @@+module Main where++import NonTermLib+import LowLevel +import SExp+import PrettyLibHighlight (Doc,pretty,nest,text,(<>))+import qualified PrettyLibHighlight as Pretty (highlight)+import HighlightStyle     (goto,cls,clearDown,clearUp,cleareol,highlightOff+                          ,highlight,Highlight(..),Colour(..)+                          ,enableScrollRegion,getTerminalSize+                          ,savePosition,restorePosition)+import Control.Monad      (when)+import System.Cmd         (system)+import System.Environment (getArgs,getProgName,getEnv)+import System.Exit        (exitWith,ExitCode(..))+import Data.List          (isPrefixOf,isSuffixOf,group,groupBy)+import System.IO          (hSetBuffering,BufferMode(..),stdin,stdout,stderr+                          ,hPutStrLn,hFlush)+import Foreign.C.String   (withCString)+++main = +  do args    <- System.Environment.getArgs+     prog    <- System.Environment.getProgName+     initialiseCount+     checkHelp args+     hatname <- getHatName args+     hatfile <- return (rectify hatname)+     withCString prog (\p-> withCString hatfile (openHatFile p))+     errloc <- getErrorLoc+     errmsg <- getErrorMessage+     checkError errmsg+     (columns, lines) <- getTerminalSize+     let state = (setOptions args) { progname=hatname, file=hatfile +                                    ,width=columns , height=lines } +     putStrLn ("---- Hat Non-Term: " ++ hatname ++ " ----")+     showFunc state+     showPath state+     if (showCount state) then  +       putStrLn ("no. reads from file: " ++ (show getCount) )+       else return ()+  where+    -- find the suspicious function+    targetfunc = greatestDist getRootNode++    -- show the suspicious function. +    -- this is separated from showing the path, because the program+    -- might not find a path at all+    showFunc state +      | targetfunc < (FileNode 4) = do putStrLn "hat-nonterm: no function found"+                                       exitWith (ExitFailure 1)+      | otherwise                 = putStrLn ("suspicious function is " +                                       ++ getFuncName targetfunc +                                       ++ " in module " +				       ++ getFuncModule targetfunc)++    -- show the non-termination path, if one can be found+    showPath state +        | funcpath == []   = do putStrLn ("hat-nonterm: no path found") +                                exitWith (ExitFailure 1)+        | (showNode state) = do mapIO putStrLn+	                          (inter (map (showSctx state) funcpath) +	    		                 (map show funcpath) )+        | otherwise        = do mapIO (putStrLn . showSctx state ) funcpath +      where funcpath = nAppSearch state getRootNode targetfunc++    rectify :: FilePath -> FilePath+    rectify f | ".hat" `isSuffixOf` f = f+              | otherwise = f ++ ".hat"++    checkError :: String -> IO ()+    checkError msg | msg `isPrefixOf` "Interrupted (^C)"= return ()+                   | otherwise = +		      do hPutStrLn stderr ("hat-nonterm: not interrupted") +		         exitWith (ExitFailure 1)++    checkHelp args | member "--help" args = do showHelp+                                               exitWith ExitSuccess+                   | otherwise            = return ()++    getHatName args = +       case args of (f:_) -> return f+                    _     -> do hPutStrLn stderr ("hat-nonterm: no trace file")+		                showHelpShort+                                exitWith (ExitFailure 1)++    showHelpShort = do putStrLn "Usage: hat-nonterm [PROG] [OPTIONS]..."+    showHelp = +      do showHelpShort+         putStrLn "  --showqual={t,f}     Show function module names"+	 putStrLn "  --showrt={t,f}       Show all nodes from the root node"+	 putStrLn "  --srcref={t,f}       Show source references for nodes"+         putStrLn "  --cutoff=<int>       Cutoff expression at depth <int>"+         putStrLn "  --numfn=<int>        Show <int> instances of the function" +++-- This function calls the search function, and cuts off the head of the+-- path if the correct option is set+nAppSearch :: State -> FileNode -> FileNode -> [Sctx]+nAppSearch state startnode func +    | (showRoot state) = reverse (map reverse resultpath)+    | otherwise        = cutAt func (reverse (map reverse resultpath))+  where +    resultpath = nAppSearchAux [startnode] (numFn state) func []+    +    cutAt _ [] = [] +    cutAt func (x:xs) | funcAppMember func x = (x:xs)+                      | otherwise            = cutAt func xs++    funcAppMember _ [] = False+    funcAppMember func (x:xs) +        | nodeType x == ExpApp +         && getFuncPtr x == func = True+        | otherwise              = funcAppMember func xs+++-- This function searches through the ART graph for a path containing N +-- applications of a particular function. It implements the search process+-- for a non-termination path described in the report+--+-- It works as follows, starting from the root node:+--    * if a node is of the wrong kind (ie SrcRef etc.) the function returns +--      an empty search path, indicating failure+--    * if the current node is a call to the required function, *and* the +--      counter indicates that only one more instance needs to be found, +--      return the search path+--    * otherwise, call the function on the node result. If this returns a+--      path, return it.+--    * otherwise, do the same for the nodes children+--    * otherwise, return an empty path+nAppSearchAux :: Sctx -> Int -> FileNode -> [Sctx] -> [Sctx]+nAppSearchAux curr@(currnode:stack) n func path+    | haltAtNode currnode    = []+    | nodeistarget && n == 1 = (curr:path)+    | resultpath /= []       = resultpath+    | otherwise              = searchChildren (getNodeChildren currnode)+  where+    nodepeek = peekResultMod (getResultHT currnode True)+    nodeistarget = (nodeType currnode) == ExpApp +                    && (getFuncPtr currnode) == func +		    && nodepeek == interrupted+    +    -- call the function on the node result, remembering to decrement the +    -- counter if the current node is an call to the target function+    resultnode = peekResultMod currnode+    resultsctx = [resultnode]+    resultpath | resultnode == currnode = []+               | nodeistarget = nAppSearchAux resultsctx (n-1) func (curr:path)+               | otherwise    = nAppSearchAux resultsctx n func (curr:path)++    -- as above, for the node's children+    searchChildren [] = []+    searchChildren (ch:rest) +        | haltAtNode ch                      = searchChildren rest+        | nodeistarget && childpathapp /= [] = childpathapp+        | childpathnoapp /= []               = childpathnoapp+        | otherwise                          = searchChildren rest+      where +        chfunc = getFuncPtr ch+	chsctx = (ch:currnode:stack)+        childpathapp = nAppSearchAux chsctx (n-1) func path +	childpathnoapp = nAppSearchAux chsctx n func path +++-- Check if its ok to keep following this node path+haltAtNode node | node <= (FileNode 4)		= True+                | ntype == ExpApp		= False+                | ntype == ExpValueApp		= False+                | ntype == ExpValueUse		= False+                | ntype == ExpConstUse		= False+                | ntype == ExpConstDef		= False+                | ntype == ExpGuard		= False+                | ntype == ExpCase		= False+                | ntype == ExpIf		= False+                | ntype == ExpForward		= False+                | ntype == ExpProjection	= False+                | ntype == Module		= True+                | ntype == SrcPos		= True+                | ntype == ExpChar		= True+                | ntype == ExpInt 		= True+                | ntype == ExpInteger		= True+                | ntype == ExpRat		= True+                | ntype == ExpRational		= True+                | ntype == ExpFloat		= True+                | ntype == ExpDouble		= True+                | ntype == ExpFieldUpdate	= True+                | ntype == ExpHidden		= True+                | ntype == ExpDoStmt		= True+                | ntype == AtomVariable		= True+                | ntype == AtomConstructor	= True+                | ntype == AtomAbstract		= True+  where ntype = nodeType node+++-- A list of Function applications, along with the first and last+-- times that they appear with an interrupted result+type FnDist = (FileNode, FileNode, FileNode)++-- find the distance between two instances of a function+fnDist :: FileNode -> FileNode -> Int+fnDist (FileNode x) (FileNode y) | x < y     = y - x +                                 | otherwise = x - y++-- This function finds the function, with the two furthest-apart+-- interrupted instances. It first calls firstLastApp to build a list of+-- *all* interrupted functions distances. It then uses foldr to find the+-- one with the greatest distance, and returns a pointer to it+greatestDist :: FileNode -> FileNode+greatestDist startnode = func+  where (func, _, _) = (foldr maxdist (nil,nil,nil) fstlast)+        fstlast = firstLastApp startnode +        maxdist (fn1, s1, e1) (fn2, s2, e2)+          | (fnDist s1 e1) >= (fnDist s2 e2) = (fn1, s1, e1) +          | otherwise                       = (fn2, s2, e2)+	++-- This function builds a list of functions that were interrupted,+-- along with pointers to their first and last applications It scans+-- through the ART file in a linear manner, using nextFileNode to get+-- the following node for a given node. If the node corresponds to an+-- interrputed function, it tries to add it to the list of functions,+-- depending on whether the instance is either the earliest or the+-- latest found so far.+firstLastApp :: FileNode -> [FnDist]+firstLastApp node +   | next == nil             = []+   | nodeType node == ExpApp+    && peek == interrupted   = addApp (getFuncPtr node) node (firstLastApp next)+   | otherwise               = firstLastApp next+  where +    next = nextFileNode node+    result = (getResultHT node True)+    peek = peekResultMod result++    addApp :: FileNode -> FileNode -> [FnDist] -> [FnDist]+    addApp fn app [] = [(fn, app, app)]+    addApp fn app ((x, fst, last):xs) +      | fn == x && app < fst   = ((x, app, last):xs) +      | fn == x && app > last  = ((x, fst, app):xs)+      | otherwise              = ((x, fst, last):(addApp fn app xs))+
+ tools/HatObserve.hs view
@@ -0,0 +1,556 @@+-- hat-observe Main++import Data.Maybe+import Data.List	(sort,isPrefixOf,isSuffixOf,intersperse)+import Control.Monad	(when,liftM)+-- import System+import System.Cmd       (system)+import System.Exit      (ExitCode(..), exitWith)+import System.Environment (getArgs, getProgName)+import Data.Char	(isDigit,digitToInt,isUpper,toUpper,isAlphaNum,isSpace)+import System.IO	(hFlush,stdout,hSetBuffering,BufferMode(..))+import Foreign.C.String	(withCString)++import Observe		(ObserveResult(..)+			,isFound,isNotFound,isInterrupted,fromFound+			,newObservation,newObservationSrc)+import Ident		(Ident(..),getIdentAt)+import Idents		(collateIdents,getAllIdents,sortIdents,showInfo)+import LowLevel		(FileNode(..),nil,openHatFile,getResult,hatVersionNumber+			,getSrcRef,getDefnRef)+import SrcRef		(SrcRef(..),readSrcRef,defnSrcRef)+import SExp		(SExp(..),Label,prettyEquation,prettyExpression+			,fileNode2SExp,funId,label,QName(..))+import HighlightStyle	(cursorUp,cleareol,highlight,Highlight(..),Colour(..)+			,getTerminalSize, hasEscapes)+import Trie		(Trie,Search(..),emptyTrie,match)+import TExp		(linearise)+import Pattern		(topMatchPat,parsePat,lexPat)+import CmdLine		(initialize,cmdline)+import CommonUI		(hatObserve,hatTrail,hatAnim,hatDetect,hatExplore+                        ,hatView+			,shortHelpText+			,Keep(..),Options(..),initialOptions+			,OptionCmd(..),optionCmd,onOff,number,safeReadInt+			,optionsUpdate,showOption)++----+data InteractiveState =+    State+	{ lastObserved	:: [FileNode]+	, more		:: Bool+	, equationsPerPage :: Int+	, hatFile       :: String+	, currentPos	:: Int+	, showRHS	:: Bool+	, options	:: Options+	, screenWidth   :: Int+	, symbolTable   :: ([Ident],[Ident],[Ident])+	}+initialState :: FilePath -> Int -> InteractiveState+initialState file width = State+	{ lastObserved = []+	, more = False+	, equationsPerPage = 10+	, hatFile = file+	, currentPos = 0+	, showRHS = True+	, options = initialOptions+	, screenWidth = width+	, symbolTable = ([],[],[])+	}+----++-----------------------------------------------------------------------+-- main entry point+-----------------------------------------------------------------------++main = do+    hSetBuffering stdout NoBuffering+    arguments <- System.Environment.getArgs+ -- putStrLn ("cmdline args: "++show arguments)+    let numArgs = length arguments+    when (numArgs < 1) (do putStrLn cmdlineHelp+                           exitWith (ExitFailure 1))+    putStrLn ("\n        hat-observe "++hatVersionNumber+              ++"    ("++shortHelpText++")\n")+    (width,_) <- getTerminalSize+    CmdLine.initialize	-- for readline functionality+    let hatFile = rectify (arguments!!0)+        state   = initialState hatFile width+    prog <- System.Environment.getProgName+    withCString prog (\p-> withCString hatFile (openHatFile p))+    when hasEscapes $ putStrLn (highlight [Foreground Red] "Loading symbol table...")+    collateIdents+    syms <- getAllIdents+    let state' = state { symbolTable = syms }+    putStr clearLine	-- delayed until next output appears+    case numArgs of+      1 -> interactive state'+      2 -> doCommand (Pattern (arguments!!1)) state'+      4 -> doCommand (Location (tail arguments)) state'+      _ -> do putStrLn cmdlineHelp+              exitWith (ExitFailure 1)+  where+    rectify :: FilePath -> FilePath+    rectify f | ".hat" `isSuffixOf` f = f+              | otherwise = f ++ ".hat"++----+showObservation :: InteractiveState -> Int -> FileNode -> IO ()+showObservation state@(State{options=opts}) i node = do+  putStr clearLine  -- delay relies on line-buffered output+  putStrLn (display (screenWidth state) opts node)+  where+  display | equations opts && showRHS state = prettyEquation (show i++" ") ""+          | otherwise                       = prettyExpression (show i++" ")+++-- arguments to showObservationList are:+--   i     :: Int		numbered equation+--   max   :: Int		how many equations to show at once+--   exprs :: [FileNode]	roots of equations+-- result is number of equations that have been shown+showObservationList :: InteractiveState -> Int -> Int -> [FileNode] -> IO Int+showObservationList state _ _ [] = do putStr clearLine; return 0+showObservationList state i 0 _  = do putStr clearLine; return 0+showObservationList state i max (e:r) = do+    showObservation state i e+    beginSearching+    count <- showObservationList state (i+1) (max-1) r+    return (count+1)++makeObserveSrc :: [String] -> ObserveResult+makeObserveSrc [mod,line,col] | all isDigit line && all isDigit col =+    newObservationSrc mod (safeReadInt 0 line) (safeReadInt 0 col)+makeObserveSrc _  | otherwise = NotFound+++makeObserve :: InteractiveState -> QName -> Maybe QName -> SExp () -> Int+               -> ObserveResult+makeObserve State{options=opts} ident1 ident2 pat arity =+    let observed = newObservation ident1 ident2 (recursiveMode opts) arity in+    if not (isFound observed) then observed+    else ( Found+         . map fromEqn+         . filter (\o-> topMatchPat o pat)+         . (case filterMode opts of+              All -> id+              _   -> uniqueify)+         . map toSEqn+         . fromFound)+         observed+++-- This is a unique-ifier which builds a Trie to compare expressions.+-- Each expression is represented as a token stream, obtained by first+-- converting the FileNode to an expression tree, then linearising the+-- tree (by pre-order traversal).  The token stream is matched against+-- the Trie, and if found, the corresponding FileNode is discarded.  If+-- not found, the representation is stored in the Trie, and the expression+-- returned.+uniqueify :: [SExp Label] -> [SExp Label]+uniqueify eqns = trymatch emptyTrie eqns+  where trymatch trie [] = []+        trymatch trie (eqn:eqns) =+            case match (linearise eqn) trie of+              Exists    -> trymatch trie eqns+              New trie' -> eqn: trymatch trie' eqns++-- For unique-ification *and* for pattern matching, we first need an+-- expression-tree representation of the equation at the file node.+-- This representation has a *very* deep cutoff value for correctness,+-- and no sugaring of subexprs to allow all forms of matching.+toSEqn :: FileNode -> SExp Label+toSEqn node =+  SEquation ("",nil)+            (fileNode2SExp 2000 False False True ("l",node))+            (fileNode2SExp 2000 False False False ("r",getResult node True))++-- After unique-ification and pattern matching, we want the original+-- file node back.+fromEqn :: SExp Label -> FileNode+fromEqn (SEquation _ lhs rhs) = snd (label lhs)++++showSomeMore :: InteractiveState -> IO (Int,Bool)+showSomeMore state =+  let showNowList = drop (currentPos state) (lastObserved state);+      hasMore = not (null (drop (equationsPerPage state) showNowList))+  in do+    beginSearching+    count <- showObservationList state (currentPos state + 1)+	                         (equationsPerPage state) showNowList+    return (count + currentPos state, hasMore)++beginSearching :: IO ()+beginSearching = when hasEscapes $ putStrLn (highlight [Foreground Red] "searching: (^C to interrupt)")++clearLine = if hasEscapes then cursorUp++cleareol else ""++interactive :: InteractiveState -> IO ()+interactive state+    | more state =+        do cmd <- getCommand "--more--> "+           case cmd of+             Pattern _ -> interactive state{more=False}+             _ -> doCommand cmd state+    | otherwise =+        do cmd <- getCommand "hat-observe> "+           doCommand cmd state+++getEquationNumber :: Int -> [FileNode] -> IO (Maybe FileNode)+getEquationNumber n lastObserved =+  let nodes = drop (n-1) lastObserved in+  if n>0 then+       if null nodes then do -- This test may take a while!+	    putStrLn "No equation with this number"+	    return Nothing+       else return (Just (head nodes))+  else return Nothing+++----+setState :: Mode -> InteractiveState -> InteractiveState+setState (O o)     state = state {options=optionsUpdate o (options state)}+setState (Group n) state = state {equationsPerPage=max n 1}++showState :: Mode -> InteractiveState -> String+showState (O o)     state  = showOption o (options state)+showState (Group _) state  = "  "++ highlight [Underscore] "group"+                             ++ "\t\t" ++ show (equationsPerPage state)++"\t"+                             ++ "number of equations per group"++----+doCommand :: Cmd -> InteractiveState -> IO()+doCommand (Help s) state = do interactiveHelp (dropWhile isSpace s)+                              interactive state+doCommand Quit state =+    if more state then interactive state{more=False}+    else return ()+doCommand More state =+    if more state then do+        putStr clearLine+        (newPos,newMore) <- showSomeMore state+	interactive (state {more=newMore,currentPos=newPos})+    else do+        when (currentPos state>0) (putStrLn "No more applications observed.")+        interactive state+doCommand (Info mod) state =+     do let (glob,_,_) = symbolTable state+        putStr (showInfo mod (sortIdents glob) "")+	interactive state+doCommand (InfoC mod) state =+     do let (_,_,constrs) = symbolTable state+        putStr (showInfo mod (sortIdents constrs) "")+	interactive state+doCommand Resize state =+     do (width,_) <- getTerminalSize+        interactive (state{screenWidth=width})+doCommand Count state =+     do when (more state)+             (putStrLn "One moment, this may take a while...")+	putStrLn ("Number of (all,unique) matching applications: "+		  ++(show (length (lastObserved state))))+	interactive state++doCommand Status state =+     do mapM_ (\m-> putStrLn (showState m state))+              [ O (Uneval True), O (Strings True), O (Lists True)+              , O (Recursive True), O (Qualify True), O (Equations True)+              , Group 0, O (CutOff 0), O (Filter All) ]+        interactive state+doCommand (Set mode) state =+     do let state' = setState mode state+        putStrLn (showState mode state')+        interactive state'++doCommand (StartTool tool) state =+     do startExternalTool tool state+	interactive state+doCommand (Source n) state =+     do node <- getEquationNumber n (lastObserved state)+        let sr = getSrcRef (fromJust node)+	when (isJust node && sr /= LowLevel.nil)+             (do System.Cmd.system (hatView (readSrcRef sr))+                 return ())+	interactive state+doCommand (Definition n) state =+     do node <- getEquationNumber n (lastObserved state)+        let atom = getDefnRef (fromJust node)+	when (isJust node)+             (do defnSR <- liftM defnSrcRef (getIdentAt atom)+                 System.Cmd.system (hatView defnSR)+                 return ())+	interactive state++doCommand (Pattern s) state =+    let (pat, ctx) = parsePat (lexPat s) in+    case pat of+      Left str -> do putStrLn ("Error in pattern: "++str)+                     interactive state+      Right p  -> do+        beginSearching+        let fun = funId p+            arity p = case p of+                        SApp _ es -> length es - 1+                        SEquation _ e _ -> arity e+                        _ -> 0+            newObserved = makeObserve state fun ctx p (arity p)+        if isNotFound newObserved || null (fromFound newObserved)+          then do+            putStrLn (clearLine ++ "no match found")+            interactive state+	  else do+            putStr clearLine+            (newPos,newMore) <- showSomeMore+                                   (state { currentPos=0+                                          , showRHS=not (isCon fun)+	 			          , lastObserved=fromFound newObserved})+            interactive (state { lastObserved=fromFound newObserved+                               , more=newMore+                               , showRHS=not (isCon fun)+                               , currentPos=newPos})+doCommand (Location ss) state =+    do putStrLn (highlight [Foreground Red]+                           "searching (source reference): (^C to interrupt)")+       let newObserved = makeObserveSrc ss+       if isNotFound newObserved || null (fromFound newObserved)+         then do+           putStrLn (clearLine ++"no match found")+           interactive state+         else do+           putStr clearLine+           (newPos,newMore) <- showSomeMore+                                  (state { currentPos=0+                                         , showRHS=True+	 			         , lastObserved=fromFound newObserved})+           interactive (state {lastObserved=fromFound newObserved+                              ,more=newMore+                              ,showRHS=True+                              ,currentPos=newPos})+doCommand (Shell cmd) state =+     do err <- system cmd+        when (err/=ExitSuccess) (putStrLn "shell command exited abnormally")+        interactive state+doCommand Unknown state =+     do putStrLn ("Unknown command.  "++shortHelpText)+        interactive state+++isCon :: QName -> Bool+isCon qn = con v+  where con (x:xs) = isUpper x || x `elem` ":[,"+        v = case qn of Plain v -> v; Qualified _ v -> v++-- Start up a new window with a new instance of a hat tool.+startExternalTool tool state =+  let file = hatFile state+      checkOK errcode s = when (errcode/=ExitSuccess)+                               (putStrLn ("ERROR: Unable to start "++s++"."))+  in case tool of+      Choose -> do+          putStrLn "choose :observe, :detect, :trail, :animate, or :explore"+      Observe pat -> do+          errcode <- system (hatObserve file pat)+          checkOK errcode "hat-observe"+      Trail num -> do+          node <- getEquationNumber num (lastObserved state)+          if isJust node then do+              errcode <- system (hatTrail file (fromJust node))+              checkOK errcode "hat-trail"+            else putStrLn ("ERROR: Equation "++show num++" not available.")+      Anim num -> do+          node <- getEquationNumber num (lastObserved state)+          if isJust node then do+              errcode <- system (hatAnim file (fromJust node))+              checkOK errcode "hat-anim"+            else putStrLn ("ERROR: Equation "++show num++" not available.")+      Detect num -> do+          node <- getEquationNumber num (lastObserved state)+          if isJust node then do+              errcode <- system (hatDetect file (fromJust node))+              checkOK errcode "hat-detect"+            else putStrLn ("ERROR: Equation "++show num++" not available.")+      Explore num -> do+          node <- getEquationNumber num (lastObserved state)+          if isJust node then do+              errcode <- system (hatExplore file (fromJust node))+              checkOK errcode "hat-explore"+            else putStrLn ("ERROR: Equation "++show num++" not available.")+++interactiveHelp s = do+    putStrLn (if null s then basicHelptext+              else detailedHelp s)+  where+    basicHelptext = "\+\------------ :help <cmd> for more detail ----------------------------------\n\+\ <query>            observe named function (:help query for pattern syntax)\n\+\ <RETURN>           show more observations (if available)\n\+\ :info              see a list of all observable functions\n\+\ :Info              see a list of all observable data constructors\n\+\ :detect <n>        start hat-detect on equation <n>\n\+\ :trail <n>         start hat-trail browser on equation <n>\n\+\ :animate <n>       start hat-anim on equation <n>\n\+\ :explore <n>       start hat-explore on equation <n>\n\+\ :observe [query]   start hat-observe in a new window with the new query\n\+\ :source <n>        show the source application for equation <n>\n\+\ :Source <n>        show the source definition for identifier in eqn <n>\n\+\ :set               show all current mode settings\n\+\ :set <flag>        change one mode setting (:help set for more detail)\n\+\ :+[n]              short-cut to increase cutoff depth by <n> (default 1)\n\+\ :-[n]              short-cut to decrease cutoff depth by <n> (default 1)\n\+\ :resize            detect new window size for pretty-printing\n\+\ :help <cmd>   :?   show this help text (:help <cmd> for more detail)\n\+\ :quit              quit\n\+\---------------------------------------------------------------------------"++    detailedHelp s+      | ':' == head s         = detailedHelp (tail s)+      | s `isPrefixOf` "query" = "\+\---------------------------------------------------------------------------\n\+\ * A simple function identifier finds all applications of that function.\n\+\     e.g. myfn\n\+\ * To restrict the number of equations, follow the function name with\n\+\   argument or result patterns.\n\+\     e.g. myfn ((:) 1 ((:) 2 _)) \n\+\          myfn \"Hello World!\" (1:(2:_)) = [1,_]\n\+\ * Another way of refining the search is to ask for calls only from a\n\+\   specific enclosing function.\n\+\     e.g. myfn _ (Con 2 _) (1 `Con` 3) in myOtherFn\n\+\\n\+\ The full query syntax is:\n\+\    identifier [pattern]*  ['=' pattern]?  ['in' identifier]?\n\+\ where\n\+\    pattern = '_'                              wildcard\n\+\            | num                              number\n\+\            | ''' char '''                     character\n\+\            | '\"' string '\"'                   string\n\+\            | '[' pattern [',' pattern]* ']'   literal list\n\+\            | Con                              nullary constructor\n\+\            | '(' Con [pattern]* ')'           constructor application\n\+\ Infix functions/constructors take the normal infix syntax.\n\+\---------------------------------------------------------------------------"+      | s `isPrefixOf` "info" || s `isPrefixOf` "Info" = "\+\ :info [module]     see a list of all observable functions\n\+\ :Info [module]     see a list of all observable data constructors\n\+\    Identifiers are listed for the named module, or if no module is named,\n\+\    then for all modules, sorted alphabetically, with occurrence counts.\n\+\    A blue count indicates completed calls, a red count indicates\n\+\    uncompleted calls (unevaluated call counts are not shown)."+      | s `isPrefixOf` "set"  = "\+\ :set               show all current mode settings\n\+\ :set <flag>        change one mode setting\n\+\   <flag> can be: uneval [on|off]      show unevaluated expressions in full\n\+\                  strSugar [on|off]    sugar character strings\n\+\                  listSugar [on|off]   sugar lists\n\+\                  recursive [on|off]   show recursive calls\n\+\                  qualified [on|off]   show all identifiers qualified\n\+\                  equations [on|off]   show rhs of equations\n\+\                  [all|unique]         show all equations or only unique\n\+\                  group <n>            number of equations listed per page\n\+\                  cutoff <n>           cut-off depth for deeply nested exprs"+      | s `isPrefixOf` "detect"  = "\+\ :detect <n>        start hat-detect on equation <n>\n\+\    hat-detect is a browser that asks\n\+\    questions about whether certain equations are correct or incorrect,\n\+\    using an automatic method to locate the source of a bug."+      | s `isPrefixOf` "explore"  = "\+\ :explore <n>        start hat-explore on equation <n>\n\+\    hat-detect allows source-based browsing."+      | s `isPrefixOf` "animate"  = "\+\ :animate <n>       start hat-anim on equation <n>\n\+\    hat-anim is new and potentially buggy.  It is a browser that animates\n\+\    the reduction of an expression to its final value."+      | s `isPrefixOf` "trail"  = "\+\ :trail <n>         start hat-trail browser on equation <n>\n\+\    hat-trail is an interactive browser that permits exploration backwards\n\+\    from a value, expression, or error message, through the function calls\n\+\    that ultimately led to the production of that value.\n\+\    When invoked from within hat-observe, hat-trail begins with the\n\+\    expression on the left of the equation numbered <n> in the list of\n\+\    equations shown by hat-observe."+      | s `isPrefixOf` "observe"  = "\+\ :observe [query]   start hat-observe in a new window with the new query\n\+\    With no argument, a new interactive hat-observe window is started for\n\+\    the same traced program.  Given a query argument, the new window starts\n\+\    with an immediate search for the expression pattern before giving\n\+\    an interactive prompt."+      | otherwise = " topic '"++s++"' has no further help text"++cmdlineHelp = "\+\Usage: hat-observe prog[.hat]\n\+\         An interactive tool to show actual function applications within\n\+\         a traced run of a Haskell program."++{-+cmdlineHelp = "\+\Usage:   hat-observe [-v] [-r] [-xu] identifier [in topidentifier] filename\n\+\Description:\n\+\       prints a table of all applications and results of the given\n\+\       top-level identifier [within the application of topidentifier].\n\+\Options:\n\+\       v: verbose mode. Unevaluated expressions are shown in full.\n\+\       r: recursive mode.  Do not omit recursive function applications.\n\+\       xu: expert's mode for a very fast response. All applications\n\+\           of the identifier are shown, rather than only the most\n\+\           general ones."+-}+++data Cmd  = Pattern String | Location [String]+          | More | Info String | InfoC String | Count+          | Help String | Quit | Unknown+          | StartTool Tool | Source Int | Definition Int+          | Status | Set Mode | Shell String | Resize+data Tool = Trail Int | Anim Int | Observe String | Detect Int | Explore Int +          | Choose+data Mode = Group Int | O OptionCmd++getCommand :: String -> IO Cmd+getCommand prompt = do+    s <- cmdline prompt+    if null s then return More+   -- else if all isDigit s then return (number (StartTool Choose) [s] 0)+      else if head s /= ':' then return (Pattern s)+      else case words (tail s) of+          [] -> return Unknown+          (cmd:ss)+              | cmd `isPrefixOf` "quit" -> return Quit+              | cmd `isPrefixOf` "help" -> return (Help (unwords ss))+              | cmd `isPrefixOf` "location" -> return (Location ss)+              | cmd `isPrefixOf` "detect"   ->+				return (number (StartTool . Detect) ss 0)+              | cmd `isPrefixOf` "explore"   ->+				return (number (StartTool . Explore) ss 0)+              | cmd `isPrefixOf` "trail"    ->+				return (number (StartTool . Trail) ss 0)+              | cmd `isPrefixOf` "animate"    ->+				return (number (StartTool . Anim) ss 0)+              | cmd `isPrefixOf` "observe"  ->+				return (StartTool (Observe (unwords ss)))+              | cmd `isPrefixOf` "source"   -> return (number Source ss 0)+              | cmd `isPrefixOf` "Source"   -> return (number Definition ss 0)+              | cmd `isPrefixOf` "info"     -> return (Info (unwords ss))+              | cmd `isPrefixOf` "Info"     -> return (InfoC (unwords ss))+              | cmd `isPrefixOf` "resize"   -> return Resize+              | cmd `isPrefixOf` "set"      ->+                  case ss of+                      []      -> return Status+                      (s:sss) ->+                        case optionCmd ss of+                          Just o  -> return (Set (O o))+                          Nothing -> if s `isPrefixOf` "group"+                                     then return (Set (number Group sss 10))+                                     else return Unknown+              | head cmd == '?' -> return (Help (unwords (tail cmd:ss)))+              | head cmd == '+' -> return (number (Set . O . Deeper)+                                                  (tail cmd:ss) 1)+              | head cmd == '-' -> return (number (Set . O . Shallower)+                                                  (tail cmd:ss) 1)+              | head cmd == '!' -> return (Shell (unwords (tail cmd:ss)))+              | otherwise  ->  return Unknown+
+ tools/HatStack.hs view
@@ -0,0 +1,33 @@+module HatStack(hatStack) where	-- HatStack main program++import LowLevel           (openHatFile,FileNode(..),nil,getParentNode+                          ,getErrorLoc,getErrorMessage+                          ,getSrcRef)+import SrcRef		  (SrcRef(..),readSrcRef)+import SExp               (SExp(..),Label,fileNode2SExp,sExp2Doc,prune)+import System.Environment (getProgName)+import Foreign.C.String   (withCString)+++-- first item is the expression, second is the position+type StackEntry = (SExp Label, Maybe (String, Int))++hatStack :: FilePath -> IO (Maybe (String, [StackEntry]))+hatStack hatfile = do+    prog <- getProgName+    withCString prog (\p-> withCString hatfile (openHatFile p))+    +    errloc <- getErrorLoc+    errmsg <- getErrorMessage+    if errloc == nil+        then return Nothing+        else return $ Just (errmsg, map toSExp $ takeWhile (/=nil) $ iterate getParentNode errloc)+    +    +toSExp :: FileNode -> (SExp Label, Maybe (String, Int))+toSExp node = let srcref = getSrcRef node+                  sr = readSrcRef srcref in+              ( fileNode2SExp 10 False True True ("l",node)+              , if (srcref==nil) then Nothing+                else Just (SrcRef.filename sr, SrcRef.line sr)+              )
+ tools/HatStackText.hs view
@@ -0,0 +1,54 @@+module Main where	-- HatStack main program++import LowLevel           (openHatFile,FileNode(..),nil,getParentNode+                          ,getErrorLoc,getErrorMessage+                          ,getSrcRef)+import SrcRef		  (SrcRef(..),readSrcRef)+import SExp               (SExp(..),Label,fileNode2SExp,sExp2Doc,prune)+import PrettyLibHighlight (Doc,pretty,nest,text,(<>),parens)+import HighlightStyle     (getTerminalSize)+import System.Environment (getArgs,getProgName)+import System.Exit        (exitWith,ExitCode(..))+import Foreign.C.String   (withCString)+import System.IO          (hPutStrLn,stderr)+import Data.List          (isSuffixOf)+import Control.Monad      (when)++import Data.Maybe (isNothing)+import HatStack (hatStack)++main = do+    args    <- System.Environment.getArgs+    hatfile <- case args of (f:_) -> return (rectify f)+                            _     -> do hPutStrLn stderr+                                                  ("hat-stack: no trace file")+                                        exitWith (ExitFailure 1)+    stack <- hatStack hatfile+    when (isNothing stack)+         (do hPutStrLn stderr ("Tracefile \""++hatfile+                               ++"\" contains no reference to a program error.")+             exitWith (ExitFailure 1))+             +    let Just (errmsg, stck) = stack+    putStrLn ("Program terminated with error:\n\t"++errmsg)+    putStrLn ("Virtual stack trace:")+    (width,lines) <- getTerminalSize+    mapM_ (putStrLn . paint width) stck+++rectify :: FilePath -> FilePath+rectify f | ".hat" `isSuffixOf` f = f+          | otherwise = f ++ ".hat"++++paint :: Int -> (SExp Label, Maybe (String, Int)) -> String+paint width (sexp, srcpos) =+    let doc = sExp2Doc False True False (\_->id) (prune 10 sexp) in+        pretty width+               (parens (maybe (text "unknown")+                              (\(mod,line)-> text mod <> text ":"+                                             <> text (show line))+                              srcpos)+               <> text "\t" <> nest 3 doc)+
+ tools/HatTrail.hs view
@@ -0,0 +1,859 @@+module Main where	-- HatTrail main program++import LowLevel		(openHatFile,getBridgeValue,hatVersionNumber+			,FileNode(..),nil,peekTrace,getResult,getParentNode+			,getErrorLoc,getErrorMessage+			,getSrcRef,getDefnRef)+import SrcRef		(SrcRef(..),readSrcRef,defnSrcRef)+import Ident		(Ident,getIdentAt)+import SExp		(SExp(..),Label,fileNode2SExp,sExp2Doc,arity,child+			,label,rebuild,children,parent,prune,funId,funLabel+			,QName(..),showQN)+import PrettyLibHighlight (Doc,pretty,nest,text,(<>))+import qualified PrettyLibHighlight as Pretty (highlight)+import HighlightStyle	(goto,cls,clearDown,clearUp,cleareol,highlightOff+			,highlight,Highlight(..),Colour(..)+			,enableScrollRegion,getTerminalSize+			,savePosition,restorePosition)+import Control.Monad	(when,liftM)+import System.Cmd       (system)+import System.Environment (getArgs,getProgName,getEnv)+import System.Exit      (exitWith,ExitCode(..))+import System.Directory	(doesFileExist)+import Data.List	(isPrefixOf,isSuffixOf,group,groupBy)+import System.IO	(hSetBuffering,BufferMode(..),stdin,stdout,stderr+			,hPutStrLn,hFlush)+import Numeric	        (showHex)+import Foreign.C.String (withCString)+import CommonUI		(hatTrail,hatObserve,hatDetect,hatAnim,hatView+                        ,hatExplore+			,Options(..),initialOptions+			,OptionCmd(..),optionCmd,onOff,number+			,optionsUpdate,showOption,showOnOff)+++-- The recurring state within the main loop of the program contains+-- the .hat filename, the terminal width and height, preferred+-- highlighting styles, etc.+data State = State+	{ file      :: FilePath		-- .hat filename+	, width     :: Int		-- terminal screen size+	, height    :: Int		-- terminal screen size+	, startLine :: Int		-- first line of the trail pane+        , styleNew  :: [Highlight]	-- highlight for current subexpr+        , styleOld  :: [Highlight]	-- highlight for previous subexprs+	, srcrefs   :: Bool		-- always show src references?+	, options   :: Options		-- common configurable display options+	}++setState :: Mode -> State -> State+setState (O o)       state = state {options=optionsUpdate o (options state)}+setState (SrcRefs b) state = state {srcrefs=b}++showState :: Mode -> State -> String+showState (O o)       state = showOption o (options state)+showState (SrcRefs b) state = "  "++highlight [Underscore] "srcrefs"+                              ++ showOnOff b+                              ++ "srcrefs shown in status line"++-- The main hat-trail program+main = do+    args    <- System.Environment.getArgs+    prog    <- System.Environment.getProgName+    hatfile <- case args of (f:_) -> return (rectify f)+                            _     -> do hPutStrLn stderr+                                                  ("hat-trail: no trace file")+                                        exitWith (ExitFailure 1)+    withCString prog (\p-> withCString hatfile (openHatFile p))+    errloc <- getErrorLoc+    errmsg <- getErrorMessage+    output <- readOutputFile hatfile+    bridge <- readBridgeFile+    (style0,style1) <- catch (do home <- getEnv "HOME"+                                 f <- readFile (home++"/.hattrailrc")+                                 return (read f))+                             (\e-> return ( [Dim,Foreground Red]+                                          , [Bold,Foreground Magenta] ))+    (columns,lines) <- getTerminalSize+    let state = State { file=hatfile, width=columns, height=lines, startLine=0+	              , srcrefs=True, styleOld=style0, styleNew=style1+                      , options=initialOptions {equations=False} }+    hSetBuffering stdin NoBuffering+    hSetBuffering stdout NoBuffering+    System.Cmd.system ("stty -icanon min 1 -echo")+    case args of+      [f,"-remote",n] -> remote state (read n)+      _ -> begin state errloc errmsg output (map peekTrace bridge)+  where+    begin :: State -> FileNode -> String -> String -> [FileNode] -> IO ()+    begin state errloc errmsg output bridge =+        do (state',root) <- chooseFromOutput state errloc errmsg output bridge+           let res = getResult root False+           if equations (options state) then+               if res == nil then+                    loop state' [( startLine state'+                                 , Sctx (SEquation ("=",nil)+                                                   (toSExp state True "l" root)+                                                   (SBottom ("b",res))) [])]+               else loop state' [( startLine state'+                                 , Sctx (SEquation ("=",nil)+                                                   (toSExp state True "l" root)+                                                   (toSExp state False "r" res))+                                        []+                                 )]+             else+             loop state' [ (startLine state', Sctx (toSExp state True "l" root)+                                                   []) ]+        where+           loop state stack = do repaint state stack+                                 (state',stack') <- selectSubExpr state stack+                                 case stack' of+                                  [] -> begin state' errloc errmsg output bridge+                                  _  -> loop state' stack'++    remote :: State -> Int -> IO ()+    remote state root =+        do putStr (highlight [Bold]+                             ("Trail: "++ replicate (width state - 8) '-'))+           let node = FileNode root+               res = getResult node False+           if equations (options state) then+               if res==nil then+                    loop state{startLine=2}+                         [( 2, Sctx (SEquation ("=",nil)+                                               (toSExp state True "l" node)+                                               (SBottom ("b",res)))+                                    [] )]+               else loop state{startLine=2}+                         [( 2, Sctx (SEquation ("=",nil)+                                               (toSExp state True "l" node)+                                               (toSExp state False "r" res))+                                    [] )]+             else loop state{startLine=2}+                       [(2, Sctx (toSExp state True "l" node) [])]+        where+           loop state stack = do repaint state stack+                                 (state', stack') <- selectSubExpr state stack+                                 case stack' of+                                   [] -> loop state' stack+                                   _  -> loop state' stack'+  +    rectify :: FilePath -> FilePath+    rectify f | ".hat" `isSuffixOf` f = f+              | otherwise = f ++ ".hat"++    readOutputFile :: FilePath -> IO String+    readOutputFile hat = do readFile (hat++".output")++    readBridgeFile :: IO [FileNode]+    readBridgeFile = do until (==nil) getBridgeValue+      where+        until :: (a->Bool) -> IO a -> IO [a]+        until pred action = do+            v <- action+            if pred v then return [] else do vs <- until pred action+                                             return (v:vs)++-- Restore the terminal before quitting+resetSystem :: State -> IO ()+resetSystem state = do+    putStr (enableScrollRegion 1 (height state))+    putStr (goto 1 (height state))+    System.Cmd.system ("stty icanon echo")+    return ()+++-- Conversion of a filenode to an S-expression+toSExp :: State -> Bool -> String -> FileNode -> SExp Label+toSExp state@State{options=opts} lhs l n =+    fileNode2SExp (cutoffDepth opts) (unevalMode opts)+                  (stringSugar opts) lhs (l,n)+++-- Allow the user to select a redex trail starting from the program output.+-- This implementation allows movement one clump of characters at a time,+-- where the clumps are based on having the same trace pointer.+chooseFromOutput :: State -> FileNode -> String -> String -> [FileNode]+                    -> IO (State,FileNode)+chooseFromOutput state errloc errmsg output bridge =+  do+    putStr (cls ++ goto 1 1)+    when (isError)+         (do putStrLn (highlight [Bold]+                                 ("Error: "++replicate (width state-8) '-'))+             putStrLn errmsg)+    when (not (null output))+         (do putStrLn (highlight [Bold]+                                 ("Output: "++replicate (width state-9) '-')))+          -- putStrLn output)+    putStr (goto 1 (startLine-1))+    putStr (highlight [Bold] ("Trail: "++replicate (width state-8) '-'))+    statusLine ("hat-trail "++hatVersionNumber++"   (:h for help, :q to quit)")+               state{startLine=startLine}+    putStr (enableScrollRegion startLine (height state))+    (state',i) <- select state{startLine=startLine} 0+    return (state', clumpNodes!!i)+  where+    select :: State -> Int -> IO (State,Int)+    select st i = do+        putStr (location i (styleNew st) clumpStrs ++ goto 1 startLine)+        c <- getCommand st+        case c of+          Movement L    -> if i==0 then select st 0 else select st (i-1)+          Movement Up   -> if i==0 then select st 0 else select st (i-1)+          Movement R    -> if i==max then select st max else select st (i+1)+          Movement Down -> if i==max then select st max else select st (i+1)+          Select -> do putStr (location i (styleOld st) clumpStrs)+                       return (st,i)+          Status -> do showCurrentSettings st+                       select st i+          Set m  -> do st' <- newSetting m st+                       select st' i+          Help   -> do showHelp st+                       putStr (goto 1 startLine ++ clearDown)+                       select st i+          Quit   -> do resetSystem st+                       exitWith ExitSuccess+          _      -> select st i++    isError   = errloc /= nil+    lenError  = if not isError then 0 else linesize (width state) errmsg + 1+    lenOutput = if null output then 0 else linesize (width state) output + 1+    startLine = lenError + chunkSize + 3+    chunkSize = let chunk = height state `div` 4 in+                if lenOutput > chunk then chunk else lenOutput+    max = length clumpStrs - 1+    clumpNodes = (if isError then (errloc:) else id) $+                 map head (group bridge)+--  clumpStrs  = (if isError then ((errmsg ++ goto 1 (1+lenError)):) else id) $+--               map (showNL . map fst)+--                   (groupBy (\(_,n) (_,m)-> n==m) (zip output bridge))+    clumpStrs  = (if isError then (errmsg:) else id) $+                 beginOutput $+                 map (showNL . map fst)+                     (groupBy (\(_,n) (_,m)-> n==m) (zip output bridge))+    showNL [] = []+    showNL ('\n':cs) = '\\':'n':'\n': showNL cs+    showNL (c:cs)    = c: showNL cs+    location i style [] = ""+    location i style xs =+        let (as,bs) = splitAt i xs+            size | isError && i<=chunkSize = lenError+chunkSize+                 | otherwise               = chunkSize+        in+        concatMap (\n-> goto 1 n ++ cleareol)	-- clean output window+                  [2+lenError .. startLine-2]+        ++ goto 1 2+        -- previously had   safeUnlines (width state) ...+        ++ unlines (take size (trim size (lines (concat as))+                               ++ lines ((highlight style (head bs))+                                          ++ concat (tail bs))))+        ++ highlightOff+    trim :: Int -> [String] -> [String]+    trim n pref = if length pref >= n then beginOutput (trim n (drop n pref))+                                      else pref+    safeUnlines w [] = []+    safeUnlines w (x:xs) = (if length x > w then take (w-4) x ++ "...\n"+                            else x++"\n") ++ safeUnlines w xs+    beginOutput  []    = []+    beginOutput (s:ss) = (goto 1 (2+lenError) ++ s): ss+ -- beginOutput  []    = [ concatMap (\n-> goto 1 n ++ cleareol)+ --                                  [2+lenError .. startLine-2]+ --                        ++ goto 1 (2+lenError) ]+ -- beginOutput (s:ss) = (concatMap (\n-> goto 1 n ++ cleareol)+ --                                 [2+lenError .. startLine-2]+ --                        ++ goto 1 (2+lenError)+ --                        ++ s)+ --                      : ss+    linesize width str = foldr (addsize width) 0 (map length (lines str))+    addsize width n total = total + (n `div` (width+1)) + 1+++++-- An S-expression context is the means of navigation through an expression.+-- It contains the "current" node, and a stack of parent nodes, each with+-- an annotation to say which child of that parent is on the direct path from+-- the root to the current node.+data Sctx = Sctx (SExp Label) [(Int, SExp Label)]++getRoot :: Sctx -> SExp Label+getRoot (Sctx s []) = s+getRoot (Sctx _ xs) = let (_,r) = last xs in r+++-- Allow the user to select a subexpression from the given expression.+-- Takes a stack of previous full expressions, and returns a new stack,+-- either pushing the new subexpression, or popping an old one.+selectSubExpr :: State -> [(Int,Sctx)] -> IO (State,[(Int,Sctx)])+selectSubExpr state stack@((lineno,sctx@(Sctx e _)):_) =+    loop (label e) sctx+  where+    loop :: Label -> Sctx -> IO (State,[(Int,Sctx)])+    loop lab@(labl,node) ctx@(Sctx e rest) = do+        let (len,str,exp) = paintOne state highlightWithSharing ctx+            extent = lineno + len+            realLineNo = if extent <= height state+                         then lineno+                         else height state - len+            newctx | null rest = Sctx exp []+                   | otherwise = ctx+        when (srcrefs state) (showSrcRef e state)+        putStr (goto 1 realLineNo ++ clearDown ++ str ++ goto 1 realLineNo)+        interpret lab newctx extent+    interpret :: Label -> Sctx -> Int -> IO (State,[(Int,Sctx)])+    interpret lab@(_,node) ctx@(Sctx e ctx') extent = do+        c <- getCommand state+        case c of+          Quit -> do resetSystem state+                     exitWith ExitSuccess+          Movement m ->+                    do let newctx@(Sctx exp _) = moveSelection m ctx+                       when (srcrefs state) (showSrcRef exp state)+                       loop (label exp) newctx+          Select -> let par = parent e in+                    if par == nil then+                         do statusLine "no parent" state+                            interpret lab ctx extent+                    else let res = getResult par False in+                      if equations (options state) then+                        if res==nil then+                          return (state, (( extent+                                          , Sctx (SEquation ("=",nil)+                                                     (toSExp state True "l" par)+                                                     (SBottom ("b",res)))+                                                 []+                                          )+                                         : (lineno, ctx): tail stack))+                        else+                          return (state, (( extent+                                          , Sctx (SEquation ("=",nil)+                                                   (toSExp state True "l" par)+                                                   (toSExp state False "r" res))+                                                 []+                                           )+                                         : (lineno, ctx): tail stack))+                      else return (state, (( extent+                                           , Sctx (toSExp state True "l" par) []+                                           )+                                          : (lineno, ctx): tail stack))+          Delete -> let stack' =+                          case ctx of+                            Sctx (SEquation _ lhs rhs) ctx'+                                | not (equations (options state)) ->+                                 (lineno,Sctx lhs ctx'):tail stack+                            Sctx _ [(_, SEquation _ lhs rhs)] ->+                                 (lineno,Sctx lhs []):tail stack+                            _ -> tail stack+                    in do+                    -- if extent >= height state+                    --   then repaint state stack'+                    --   else putStr (goto 1 lineno ++ clearDown)+                       return (state,stack')+          Shrink -> let newctx = Sctx (cut lab e)+                                      (map (\(i,e)->(i,cut lab e)) ctx')+                    in do repaint state ((lineno,newctx):tail stack)+                          loop (label e) newctx+          Expand -> let newctx = Sctx (join state lab e)+                                      (map (\(i,e)->(i,join state lab e)) ctx')+                    in do repaint state ((lineno,newctx):tail stack)+                          loop (label e) newctx+          Revert -> let newctx = Sctx (revert state lab e)+                                      (map (\(i,e)->(i,revert state lab e)) ctx')+                    in do repaint state ((lineno,newctx):tail stack)+                          loop (label e) newctx+          Detect ->  do System.Cmd.system (hatDetect (file state) node)+                        interpret lab ctx extent+          Trail  ->  do System.Cmd.system (hatTrail (file state) node)+                        interpret lab ctx extent+          Anim   ->  do System.Cmd.system (hatAnim (file state) node)+                        interpret lab ctx extent+          Explore ->  do System.Cmd.system (hatExplore (file state) node)+                         interpret lab ctx extent+          ObserveAll -> do System.Cmd.system (hatObserve (file state)+                                                     (showQN True (funId e)))+                           interpret lab ctx extent+          ObservePat p ->+                        do System.Cmd.system (hatObserve (file state) p)+                           interpret lab ctx extent+          ObserveSrc -> do let srcref = expSrcRef e+                           when (srcref /= nil)+                                (let sr = readSrcRef srcref in+                                 do System.Cmd.system+                                        (hatObserve (file state)+                                            (SrcRef.filename sr+                                            ++" "++show (SrcRef.line sr)+                                            ++" "++show (SrcRef.column sr)))+                                    return ())+                           interpret lab ctx extent+          Repaint -> do repaint state stack+                        loop lab ctx+          Resize -> resize state stack+          Source -> do let srcref = expSrcRef e+                       when (srcref /= nil)+                            (do System.Cmd.system (hatView (readSrcRef srcref))+                                showSrcRef e state)+                       interpret lab ctx extent+          Definition -> let defn = getDefnRef (funLabel e)+                        in if defn==nil then do+                            statusLine (showQN (showQual (options state))+                                               (funId e)+                                       ++": defn not available") state+                            interpret lab ctx extent+                        else do+                            defnSR <- liftM defnSrcRef (getIdentAt defn)+                            ok <- doesFileExist (SrcRef.filename defnSR)+                            if not ok then+                                statusLine (showQN (showQual (options state))+                                                   (funId e)+                                           ++": defn not found") state+                              else do+                                System.Cmd.system (hatView defnSR)+                                statusLine (showQN (showQual (options state))+                                                   (funId e)+                                           ++": definition") state+                            interpret lab ctx extent+          Result -> let r = getRoot ctx in+                    case r of+                      SEquation _ lhs rhs ->+                           do putStr (goto 1 lineno ++ clearDown)+                              return ( state+                                     , (lineno, (Sctx lhs [])) : tail stack )+                      _ -> let res = getResult (snd (label r)) False in+                           if res==nil then+                                let bot = SBottom ("b",FileNode 1) in+                                return ( state+                                       , ( lineno+                                         , (Sctx r [(0, SEquation ("=",nil)+                                                                  r bot)])+                                         ) : tail stack)+                           else let rhs = toSExp state False "r" res in+                                return ( state+                                       , ( lineno+                                         , (Sctx rhs [(1, SEquation ("=",nil)+                                                                     r rhs)])+                                         ) : tail stack)+          Status -> do showCurrentSettings state+                       repaint state stack+                       interpret lab ctx extent+          Set mode -> do state' <- newSetting mode state+                         let rootlabel = case getRoot ctx of+                                           SEquation _ lhs rhs -> label lhs+                                           expr                -> label expr+                         return ( state'+                                , ( ( lineno+                                    , Sctx (toSExp state' True "l"+                                                   (snd rootlabel))+                                           []+                                    ) : tail stack))+          Help -> do showHelp state+                     repaint state stack+                     loop lab ctx+          _ -> interpret lab ctx extent+++-- To shrink or expand the current node in the S-expression, we must+-- shrink or expand it at every level in the context path as well.+cut :: Eq a => a -> SExp a -> SExp a+cut v exp = let l = label exp in+            if l==v then SCut v+                    else rebuild exp (map (cut v) (children exp))+join :: State -> Label -> SExp Label -> SExp Label+join state v exp = let l = label exp in+                   if l==v then toSExp state False (fst v) (snd v)+                           else rebuild exp (map (join state v) (children exp))++-- To revert a subexpression means to display it in its less-than-finally-+-- evaluated form.  In particular, rather than seeing a lambda expression+-- in the function position, you might prefer the higher-order composition that+-- led to the lambda.  We can /only/ do reversion if the parent of the+-- highlighted expression has the expression itself as its result, so there+-- is a direct equivalence of value.+revert :: State -> Label -> SExp Label -> SExp Label+revert state v exp =+    let l = label exp+        node = snd v+        par = getParentNode node+        res = getResult par False+    in if l==v  && res==node+       then toSExp state True (fst v) par+       else rebuild exp (map (revert state v) (children exp))++-- Movement within the S-expression tree can be specified in a couple of+-- different ways:+--   Pre-order traversal:+--     R:  if a branch, go down and left+--         if a leaf, go up and right+--     L:  if a branch, go up, left, and down to the right+--         if a leaf, go up, left, and down to the right+--   Level navigation:+--     Up:    go to the enclosing expr (if there is one)+--     Down:  go to the first interior subexpression (if there is one)+--     JumpR: go one expr to the right within the enclosing expr+--     JumpL: go one expr to the left within the enclosing expr+moveSelection :: Cursor -> Sctx -> Sctx+moveSelection R (Sctx s ctx) =+    if arity s > 0 then Sctx (child 0 s) ((0,s): ctx) else unwindr ctx+    where unwindr [] = Sctx s ctx+          unwindr ((i,p):ctx) =+              let i' = i+1 in+              if i' < arity p then Sctx (child i' p) ((i',p):ctx)+              else unwindr ctx+moveSelection L (Sctx s ctx) = unwindl ctx+    where unwindl [] = Sctx s []+          unwindl ((i,p):ctx) =+              let i' = i-1 in+              if i > 0 then windr (child i' p) ((i',p):ctx)+              else Sctx p ctx+          windr p ctx = let rhs = (arity p) - 1 in+                        if rhs >= 0 then windr (child rhs p) ((rhs,p):ctx)+                                    else Sctx p ctx+moveSelection JumpR ctx@(Sctx _ []) = ctx+moveSelection JumpL ctx@(Sctx _ []) = ctx+moveSelection JumpR ctx@(Sctx s ((i,p):ctx')) =+    let i' = i+1 in+    if i' < arity p then Sctx (child i' p) ((i',p):ctx') else ctx+moveSelection JumpL ctx@(Sctx s ((i,p):ctx')) =+    let i' = i-1 in+    if i > 0 then Sctx (child i' p) ((i',p):ctx') else ctx+moveSelection Up ctx@(Sctx _ [])           = ctx+moveSelection Up     (Sctx _ ((i,p):ctx')) = Sctx p ctx'+moveSelection Down ctx@(Sctx s ctx') =+    if arity s > 0 then Sctx (child 0 s) ((0,s):ctx') else ctx+moveSelection ListLeft (Sctx s ((0,SApp _ (SId _ (Qualified _ ":") _ : _))+                               :(1, p@(SApp _ (SId _ (Qualified _ ":") _+                                              : hd: tl)))+                               :ctx')) =+    Sctx hd ((0,p):ctx')+moveSelection ListRight (Sctx s ((0,p'@(SApp _ (SId _ (Qualified _ ":") _ : _:+                                       p@(SApp _ (SId _ (Qualified _ ":") _+                                                 : hd: tl)):_)))+                                :ctx')) =+    Sctx hd ((0,p):(1,p'):ctx')+moveSelection ListLeft  ctx | otherwise = ctx+moveSelection ListRight ctx | otherwise = ctx+++-- Paint a single stack element (Int,Sctx) to a String.  While we're+-- at it, most callers want to know how many lines are used by the string.+paintOne :: State+            -> (State -> Label -> Label -> Doc -> Doc)	-- subexpr highlighter+            -> Sctx					-- abstract expression+            -> (Int,String,SExp Label)	-- (length, text, squashed expr)+paintOne state high ctx@(Sctx node _) =+    -- Find the root of the S-expr, then make it fit on the screen+    (squash state (high state (label node)) (cutoffDepth (options state))+    . getRoot) ctx+  where+    -- When an expression does not fit on screen, it must be progressively+    -- reduced in size (via cutoff depth) until it does fit.+    squash :: State -> (Label->Doc->Doc) -> Int -> SExp Label+              -> (Int,String,SExp Label)+    squash state high cut s =+        let       -- cut-down the expression to size+            exp = prune cut s+    	      -- paint SExp as a Doc, highlighting current subtree node+            doc = sExp2Doc False (listSugar (options state))+                           (showQual (options state)) high exp+    	      -- and then pretty-print it, with introductory marker+            str = pretty (width state - 2) (text "<- " <> nest 3 doc)+            len = length (lines str)+        in        -- now does it fit?+        if len <= height state - startLine state+        then (len,str,exp)+        else squash state high (cut`div`2) s++-- Various different styles of highlighting are required in different+-- screen contexts.+highlightOldSelection, highlightNewSelection, highlightWithSharing+    :: State -> Label -> Label -> Doc -> Doc+highlightOldSelection state node v =+    if v == node then Pretty.highlight (styleOld state) else id+highlightNewSelection state node v =+    if v == node then Pretty.highlight (styleNew state) else id+highlightWithSharing state (labl,nod) (l,n) =+    if l==labl then Pretty.highlight (styleNew state)+    else if n==nod then Pretty.highlight (styleOld state)+    else id+++-- Repaint screen, or possibly start afresh and follow the same path+-- through the trails (e.g. save state and restore?)++-- This implementation of `repaint' tries to calculate only what+-- is visible on screen, rather than repainting the entire trail.+-- It starts painting at the bottom of the screen and goes upwards+-- until the screen is full, then stops.+repaint :: State -> [(Int,Sctx)] -> IO ()+repaint state [] =+    do putStr (goto 1 (startLine state) ++ clearDown)+repaint state ((expBegin,exp):stack) =+    do putStr (goto 1 start ++ clearDown)+       putStr (goto 1 (expBegin-(offset`max`0)) ++ str)+       if offset <= 0			-- everything fits on screen?+         then do putStr (goto 1 expBegin ++ str)+                 mapM_ paintAll stack+         else do putStr (goto 1 (expBegin-offset) ++ str)+                 mapM_ paintAll (visible stack)+                 putStrLn (goto 1 start ++ partial stack)+  where+    start = startLine state+    extent = expBegin + len+    offset = extent - height state	-- reduce absolute linenums to fit+    (len,str,_) = paintOne state highlightNewSelection exp -- most recent item++    paintAll i@(lineno,exp) =+        let (_,str,_) = paintOne state highlightOldSelection exp in+        putStr (goto 1 lineno ++ str)++    visible [] = []+    visible ((lineno,exp):rest) =+        let adjusted = lineno - offset in+        if adjusted >= start then (adjusted,exp): visible rest else []+    partial [] = ""+    partial ((lineno,exp):rest) =+        let adjusted = lineno - offset in+        if adjusted > start then partial rest	-- keep looking+        else if adjusted == start then ""	-- no partial trail+        else ( unlines				-- partial trail+             . drop (start - adjusted)+             . lines+             . (\(_,x,_)->x)+             . paintOne state highlightOldSelection ) exp+      ++-- Repaint the screen following a resizing of the terminal.  This means+-- we need to recalculate all the line numbers, and we must repaint the+-- entire trail.+resize :: State -> [(Int,Sctx)] -> IO (State,[(Int,Sctx)])+resize state stack =+    do (columns,lines) <- getTerminalSize+       let state' = state {width=columns,height=lines}+       putStr (enableScrollRegion (startLine state') (height state'))+       putStr (goto 1 (startLine state') ++ clearDown)+       stack' <- paint state' (startLine state') [] (reverse stack)+       return (state',stack')+  where+    paint state _ acc [] = return acc+    paint state lineno acc ((_,ctx@(Sctx node _)):stack) =+        let (len,str,_) = paintOne state highlightOldSelection ctx+            extent = lineno + len+        in do+        if (extent < height state)+          then putStrLn (goto 1 lineno ++ str)	-- either careful placement+          else putStrLn str		-- or allow bottom of screen to scroll+        paint state extent ((lineno,ctx):acc) stack+++-- Various status-line things, such as source reference printing, showing+-- the current settings, etc.++expSrcRef :: SExp Label -> FileNode+expSrcRef (SEquation _ lhs rhs) = expSrcRef lhs+expSrcRef exp = getSrcRef (snd (label exp))++showSrcRef :: SExp Label -> State -> IO ()+showSrcRef exp state =+    let srcref = expSrcRef exp in+    if srcref == nil+    then statusLine "no src reference" state+    else let sr = readSrcRef srcref in+         statusLine (SrcRef.filename sr ++" line: "++show (SrcRef.line sr)+                     ++" col: "++show (SrcRef.column sr)) state++statusLine :: String -> State -> IO ()+statusLine "" state =+    do putStr (savePosition ++ goto 15 (startLine state - 1)+               ++ highlight [Bold] (replicate 63 '-') ++ restorePosition)+statusLine msg state =+    do let dmsg = detab msg+       putStr (savePosition ++ goto 15 (startLine state - 1)+               ++ ' ': take 61 dmsg ++ " "+               ++ highlight [Bold] (replicate (max 0 (61 - length dmsg)) '-')+               ++ restorePosition)+       hFlush stdout+  where+    detab [] = []+    detab ('\t':cs) = " - "++detab cs+    detab (c:cs) = c: detab cs++showCurrentSettings :: State -> IO ()+showCurrentSettings state@State{options=opts} =+    do statusLine "current settings" state+       moreViewer (map (\m-> showState m state) modes) state+  where+    modes = [ O (Uneval True), O (Strings True), O (Lists True)+            , O (Qualify True), O (Equations True)+            , SrcRefs True, O (CutOff 0) ]++newSetting :: Mode -> State -> IO State+newSetting mode state =+    do let state' = setState mode state+       statusLine (showState mode state') state'+       System.Cmd.system ("sleep 1")+       return state'+++-- A simple key-stroke interpreter.+data Cmd = Movement Cursor+         | Select | Delete  | Shrink | Expand | Revert+         | Reduce | Result  | Source | Definition+         | Detect | Trail   | Anim | Explore +         | ObserveAll | ObservePat String | ObserveSrc+         | Quit   | Unknown | Help+         | Repaint  | Resize+         | Set Mode | Status++data Cursor = L | R | JumpL | JumpR | Up | Down | ListLeft | ListRight+data Mode   = SrcRefs Bool | O OptionCmd++getCommand :: State -> IO Cmd+getCommand state = do+    c <- getChar+    case c of+      'x'    -> return Quit+      '\n'   -> return Select+      ' '    -> return Reduce+      '\DEL' -> return Delete+      '\BS'  -> return Delete+      '-'    -> return Shrink+      '+'    -> return Expand+      '='    -> return Result+      '<'    -> return (Movement JumpL)+      '>'    -> return (Movement JumpR)+      ','    -> return (Movement JumpL)	-- unshifted <+      '.'    -> return (Movement JumpR)	-- unshifted >+      '['    -> return (Movement JumpL)+      ']'    -> return (Movement JumpR)+   -- '['    -> return (Movement ListLeft)+   -- ']'    -> return (Movement ListRight)+      '\^L'  -> return Repaint+      '\^R'  -> return Resize+      'r'    -> return Revert+      '\ESC' -> do+          c <- getChar+          case c of+            '[' -> do+                c <- getChar+                case c of+                  'D' -> return (Movement L)+                  'C' -> return (Movement R)+                  'A' -> return (Movement Up)+                  'B' -> return (Movement Down)+                  _   -> return Unknown+            'O' -> do+                c <- getChar+                case c of+                  'D' -> return (Movement L)+                  'C' -> return (Movement R)+                  'A' -> return (Movement Up)+                  'B' -> return (Movement Down)+                  _   -> return Unknown+            _   -> return Unknown+      ':' -> do+          putStr (savePosition ++ goto 1 (height state)++":")+          cmd <- colonCmd 1 ""+          putStr (goto 1 (height state) ++ cleareol ++ restorePosition)+          return cmd+      _   -> return Unknown++-- a specialised input mode on the bottom line of the screen for ':' commands+colonCmd :: Int -> String -> IO Cmd+colonCmd 0 _ = return Unknown+colonCmd n s = do+    let (w:ws) = words (reverse s)+    c <- getChar+    case c of+      '\n' | null s -> return Unknown+           | w `isPrefixOf` "source" -> return Source+           | w `isPrefixOf` "Source" -> return Definition+           | w `isPrefixOf` "set" ->+               case ws of+                 [] -> return Status+                 (s:ss) ->+                   case optionCmd ws of+                     Just o  -> return (Set (O o))+                     Nothing -> if s `isPrefixOf` "srcrefs"+                                then return (maybe Unknown Set+                                                   (onOff SrcRefs ss))+                                else return Unknown+           | w `isPrefixOf` "observe"  -> if null ws then return ObserveAll+                                          else return (ObservePat (unwords ws))+           | w `isPrefixOf` "location" -> return ObserveSrc+           | w `isPrefixOf` "trail"    -> return Trail+           | w `isPrefixOf` "animate"  -> return Anim+           | w `isPrefixOf` "detect"   -> return Detect+           | w `isPrefixOf` "explore"  -> return Explore+           | w `isPrefixOf` "resize"   -> return Resize+           | w `isPrefixOf` "quit" -> return Quit+           | w `isPrefixOf` "help" -> return Help+           | head w == '?' -> return Help+           | head w == '+' -> return (number (Set . O .Deeper) (tail w:ws) 1)+           | head w == '-' -> return (number (Set . O .Shallower) (tail w:ws) 1)+           | otherwise     -> return Unknown+           where (w:ws) = words (reverse s)+      '\DEL' -> do putStr "\DEL \DEL"+                   colonCmd (n-1) (tail s)+      '\BS'  -> do putStr "\BS \BS"+                   colonCmd (n-1) (tail s)+      _ -> do putChar c+              colonCmd (n+1) (c:s)+++-- Help text is painted to screen here, but erased by the caller.+showHelp :: State -> IO ()+showHelp state =+    do statusLine "keystrokes/commands available" state+       moreViewer (lines helpText) state+  where helpText = "\+\ cursor keys   movement within current expression\n\+\ [ and ] keys  movement within current expression\n\+\ RETURN        show parent expression of selected expression\n\+\ =             show final result of the whole expression line\n\+\ BACKSPACE     remove most recently-added expression/equation\n\+\ -/+           shrink/expand a cutoff expression\n\+\ ^L            repaint the display if it gets corrupted\n\+\ ^R            repaint the display after resizing the window\n\+\ :source       look at the source-code application of this expression\n\+\ :Source       look at the source-code definition of current function\n\+\ :observe      use hat-observe to find all applications of this function\n\+\ :observe pat  use hat-observe to find all applications matching a pattern\n\+\ :location     use hat-observe to find all applications at this call site\n\+\ :trail        start a fresh hat-trail with the current expression\n\+\ :detect       use hat-detect to debug the current expression\n\+\ :animate      use hat-anim to animate reduction of the current expression\n\+\ :set          show all current mode settings\n\+\ :set <flag>   change one mode setting\n\+\   <flag> can be: uneval [on|off]      show unevaluated expressions in full\n\+\                  strSugar [on|off]    sugar character strings\n\+\                  listSugar [on|off]   sugar lists with [,,,] \n\+\                  equations [on|off]   show equations, not just redexes\n\+\                  qualified [on|off]   show module qualifiers on all names\n\+\                  cutoff <n>           cut-off depth for deeply nested exprs\n\+\ :+[n]         shortcut to increase cutoff depth\n\+\ :-[n]         shortcut to decrease cutoff depth\n\+\ :resize       repaint the display after resizing the window\n\+\ :help   :?    show this help text\n\+\ :quit         quit\n"++{-+\ SPACE         show one reduction step of whole expression\n\+-}++-- A 'more'-style viewer for text that is longer than the screen height.+moreViewer :: [String] -> State -> IO ()+moreViewer lines state =+  let maxsize = height state - startLine state in+  if length lines < maxsize+  then do putStr (goto 1 (startLine state) ++ clearDown)+          putStr (unlines lines)+          putStr (highlight [Bold] (replicate (width state - 1) '-'))+          _ <- getChar+          return ()+  else do let (top,rest) = splitAt (maxsize-1) lines+          putStr (goto 1 (startLine state) ++ clearDown)+          putStr (unlines top)+          putStr (highlight [Bold] (replicate (width state - 7) '-'+                                   ++ "more->"))+          _ <- getChar+          moreViewer rest state
+ tools/Highlightstyle.hs view
@@ -0,0 +1,136 @@+-- Partially taken from Hugs AnsiScreen.hs library:+module HighlightStyle+  ( highlightOn+  , highlightOff+  , highlight+  , cleareol, clearbol, clearline, clearDown, clearUp, cls+  , goto, home+  , cursorUp, cursorDown, cursorLeft, cursorRight+  , savePosition, restorePosition+  , Highlight(..)+  , Colour(..)+  , colourCycle+  , enableScrollRegion, scrollUp, scrollDown+  , lineWrap++  , getTerminalSize	-- :: IO (Int,Int)  (width,height)+  , hasEscapes+  ) where++import Data.List (intersperse,isPrefixOf)+import System.Process(readProcessWithExitCode)+import System.Exit(ExitCode(ExitSuccess))+-- import Run  (runAndReadStdout)+import Data.Char (isDigit)+import System.Info (os)+++hasEscapes :: Bool+hasEscapes = os /= "windows" && os /= "mingw32"+++-- Basic screen control codes:++type Pos           = (Int,Int)++at        :: Pos -> String -> String+goto      :: Int -> Int -> String+home      :: String+cls       :: String++at (x,y) s  = goto x y ++ s+goto x y    = '\ESC':'[':(show y ++(';':show x ++ "H"))+home        = goto 1 1++cursorUp    = "\ESC[A"+cursorDown  = "\ESC[B"+cursorRight = "\ESC[C"+cursorLeft  = "\ESC[D"++cleareol    = "\ESC[K"+clearbol    = "\ESC[1K"+clearline   = "\ESC[2K"+clearDown   = "\ESC[J"+clearUp     = "\ESC[1J"+-- Choose whichever of the following lines is suitable for your system:+cls         = "\ESC[2J"     -- for PC with ANSI.SYS+--cls         = "\^L"         -- for Sun window++savePosition    = "\ESC7"+restorePosition = "\ESC8"+++data Colour = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White+  deriving (Eq,Show,Read,Enum)++data Highlight =+    Normal+  | Bold+  | Dim+  | Underscore+  | Blink+  | ReverseVideo+  | Concealed+  | Foreground Colour+  | Background Colour+  deriving (Eq,Show,Read)++instance Enum Highlight where+  fromEnum Normal       = 0+  fromEnum Bold         = 1+  fromEnum Dim          = 2+  fromEnum Underscore   = 4+  fromEnum Blink        = 5+  fromEnum ReverseVideo = 7+  fromEnum Concealed    = 8+  fromEnum (Foreground c) = 30 + fromEnum c+  fromEnum (Background c) = 40 + fromEnum c++highlight :: [Highlight] -> String -> String+highlight attrs s = highlightOn attrs ++ s ++ highlightOff++highlightOn _  | not hasEscapes = ""+highlightOn []     = highlightOn [Normal]+highlightOn attrs  = "\ESC["+                     ++ concat (intersperse ";" (map (show.fromEnum) attrs))+                     ++"m"++highlightOff = if hasEscapes then "\ESC[0m" else ""+++-- An infinite supply of colours.+colourCycle :: [Colour]+colourCycle = cycle [Red,Blue,Magenta,Green,Cyan]+++-- Scrolling+enableScrollRegion :: Int -> Int -> String+enableScrollRegion start end = "\ESC["++show start++';':show end++"r"++scrollDown  = "\ESCD"+scrollUp    = "\ESCM"++-- Line-wrapping mode+lineWrap True  = "\ESC[7h"+lineWrap False = "\ESC[7l"++-- Find width and height of terminal screen+getTerminalSize :: IO (Int,Int)+getTerminalSize =+    if hasEscapes then do+        -- str <- runAndReadStdout "resize -u"+        (exitCode, stdout, stderr) <- readProcessWithExitCode "resize" ["-u"] ""+        if (exitCode == ExitSuccess && stderr == "")+          then+            let ls = lines stdout in+              return (find "COLUMNS" ls, find "LINES" ls)+          else+            return (80, 30)+    else+        return (80, 30)+  where+    find x  []    = 0+    find x (s:ss) | x `isPrefixOf` s = read (filter isDigit s)+                  | otherwise        = find x ss+    s `containedIn` [] = False+    s `containedIn` x@(_:xs) = s `isPrefixOf` x  || s `containedIn` xs
+ tools/Ident.hs view
@@ -0,0 +1,74 @@+module Ident+  ( Ident(..)+  , getIdentAt		-- :: FileNode -> IO Ident+  ) where++import LowLevel		(FileNode(..))+import System.IO.Unsafe (unsafePerformIO)+import Foreign.Ptr      (Ptr)+import Foreign.Marshal.Alloc (free)+import Foreign.C.String	(CString, peekCString)++--foreign import ccall "malloc.h &free" finaliserFree :: FunPtr (Ptr a -> IO ())++-- All possible relevant information about an identifier+data Ident = Ident+  { i_name	:: String+  , i_modname	:: String+  , i_srcfile	:: String+  , i_fixity	:: Int+  , i_arity	:: Int+  , i_defnline	:: Int+  , i_defncol	:: Int+  , i_defnlineend :: Int+  , i_defncolend  :: Int+  , i_isTraced	:: Bool+  , i_caf       :: Bool+  , i_uses      :: Int+  , i_pending   :: Int+  , i_thunks    :: Int+  }++foreign import ccall "artutils.h" readAtomAt    :: FileNode -> IO (Ptr Ident)+foreign import ccall "artutils.h" identName     :: Ptr Ident -> IO CString+foreign import ccall "artutils.h" identModName  :: Ptr Ident -> IO CString+foreign import ccall "artutils.h" identSrcFile  :: Ptr Ident -> IO CString+foreign import ccall "artutils.h" identFixity   :: Ptr Ident -> IO Int+foreign import ccall "artutils.h" identArity    :: Ptr Ident -> IO Int+foreign import ccall "artutils.h" identDefnLine :: Ptr Ident -> IO Int+foreign import ccall "artutils.h" identDefnCol  :: Ptr Ident -> IO Int+foreign import ccall "artutils.h" identDefnLineEnd :: Ptr Ident -> IO Int+foreign import ccall "artutils.h" identDefnColEnd  :: Ptr Ident -> IO Int+foreign import ccall "artutils.h" identIsTraced :: Ptr Ident -> IO Bool++getIdentAt :: FileNode -> IO Ident+getIdentAt n = do+    p <- readAtomAt n	-- p is malloc'ed in C land+    nm  <- identName p+    mod <- identModName p+    src <- identSrcFile p+    fix <- identFixity p+    ar  <- identArity p+    dl  <- identDefnLine p+    dc  <- identDefnCol p+    dle <- identDefnLineEnd p+    dce <- identDefnColEnd p+    tr  <- identIsTraced p+    snm  <- peekCString nm+    smod <- peekCString mod+    ssrc <- peekCString src+    free p		-- dispose of p again+    return Ident+	{ i_name     = snm+	, i_modname  = smod+	, i_srcfile  = ssrc+	, i_fixity   = fix+	, i_arity    = ar+	, i_defnline = dl+	, i_defncol  = dc+        , i_defnlineend = dle+        , i_defncolend  = dce+	, i_isTraced = tr+	}++---------------------------------------------------------------------
+ tools/Idents.hs view
@@ -0,0 +1,183 @@+{-# LANGUAGE EmptyDataDecls #-}++module Idents+  ( Ident(..)+  , collateIdents	-- :: IO ()+  , getAllIdents	-- :: IO ([Ident],[Ident],[Ident])+  , AllInfo		-- type AllInfo = [(String,[(String,Ident)])]+  , sortIdents		-- :: [Ident] -> AllInfo+  , showInfo		-- :: String -> AllInfo -> ShowS+  ) where++import LowLevel		(FileNode(..))+import Foreign.Ptr      (Ptr)+import Foreign.C.String (CString, peekCString)+import System.IO.Unsafe (unsafePerformIO)+import Foreign.Marshal.Alloc (free)+import Ident		(Ident(..),getIdentAt)+import Data.List+import HighlightStyle++---------------------------------------------------------------------+data Item++foreign import ccall "hat-names.h" getItemPtr  :: Ptr (Ptr Item) -> Int+							 -> IO (Ptr Item)+foreign import ccall "hat-names.h" itemIdent   :: Ptr Item -> IO FileNode+foreign import ccall "hat-names.h" itemArity   :: Ptr Item -> IO Int+foreign import ccall "hat-names.h" itemUses    :: Ptr Item -> IO Int+foreign import ccall "hat-names.h" itemPending :: Ptr Item -> IO Int+foreign import ccall "hat-names.h" itemThunks  :: Ptr Item -> IO Int++getOneIdent :: Ptr (Ptr Item) -> Int -> IO Ident+getOneIdent a n = do+  p <- getItemPtr a n+  atom  <- itemIdent p+  arity <- itemArity p+  uses  <- itemUses p+  pend  <- itemPending p+  th    <- itemThunks p+  ident <- getIdentAt atom+  free p+  return ident+	{ i_caf  = arity==0+	, i_uses = uses+	, i_pending = pend+	, i_thunks = th+	}++foreign import ccall "hat-names.h" collateIdents :: IO ()++foreign import ccall "hat-names.h" getGlobals  :: IO (Ptr (Ptr Item))+foreign import ccall "hat-names.h" getLocals   :: IO (Ptr (Ptr Item))+foreign import ccall "hat-names.h" getConstrs  :: IO (Ptr (Ptr Item))+foreign import ccall "hat-names.h" getGlobalsN :: IO Int+foreign import ccall "hat-names.h" getLocalsN  :: IO Int+foreign import ccall "hat-names.h" getConstrsN :: IO Int++getAllIdents :: IO ([Ident],[Ident],[Ident])+getAllIdents = do+  g  <- getGlobals+  gi <- getGlobalsN+  l  <- getLocals+  li <- getLocalsN+  c  <- getConstrs+  ci <- getConstrsN+  gs <- getAll g gi+  ls <- getAll l li+  cs <- getAll c ci+  return (gs, ls, cs)+  where+    getAll :: Ptr (Ptr Item) -> Int -> IO [Ident]+    getAll p i = mapM (getOneIdent p) [0..(i-1)]++---------------------------------------------------------------------+{-+-- InfoCmd describes how the data about identifiers should be presented.+-- For the moment, we just implement one style, AllByModule.+data InfoCmd+  = AllByModule | AllByAlpha | AllByFrequency+  | ModuleByAlpha String | ModuleByFrequency String+  | Individual (Maybe String) String+-}++--+--		[(modulename, [(idname,identifier info)])]+type AllInfo = [(String,[(String,Ident)])]++sortIdents :: [Ident] -> AllInfo+sortIdents is = foldr insMod [] is+  where+    insMod i []+	-- exclude identifiers with zero counts+        | (i_uses i == 0) && (i_pending i == 0) = []+        | otherwise = [(i_modname i, [(i_name i, i)])]+    insMod i xs@(o@(x,ys):rest)+        | (i_uses i == 0) && (i_pending i == 0)  = xs+        | i_isTraced i || not (i_caf i) =+          let m = i_modname i+              n = i_name i in+          case compare m x of+            LT -> (m,[(n,i)]): xs+         -- EQ -> (m, insertBy (\(n,i) (n',i')->compare n n') (n,i) ys): rest+            EQ -> (m, merge (n,i) ys): rest+            GT -> o : insMod i rest+        | otherwise = xs++merge (n,i) [] = [(n,i)]+merge (n,i) ((n',i'):nis) =+    case compare n n' of+      LT -> (n,i): (n',i'): nis+      EQ -> (n, combine i i'): nis+      GT -> (n',i'): merge (n,i) nis+  where+    combine i i' = i { i_uses    = i_uses i + i_uses i'+                     , i_pending = i_pending i + i_pending i'+                     , i_thunks  = i_thunks i + i_thunks i'+                     }++{-+showInfo :: AllInfo -> ShowS+showInfo xs = foldr (.) id (map showMod xs)+  where+    showMod (m,ns)  = showString (highlight [Foreground Blue] m) . nl .+                      foldr (.) id (map showIdent ns) . nl+    showIdent (n,i) = times 4 space+                      . (let pend = i_pending i in+                         if pend>0 then+                            showString (highlight [Foreground Red] (show pend))+                         else id)+                      . showString (highlight [Foreground Blue]+                                              (show (i_uses i)))+                      . space . showString n++    nl    = showChar '\n'+    space = showChar ' '+    times n x = foldr (.) id (replicate n x)+-}++showInfo :: String -> AllInfo -> ShowS+showInfo mod xs =+    case mod of+      "" -> foldr (.) id (map showMod xs)+      _  -> case lookup mod xs of+              Just v  -> showMod (mod,v)+              Nothing -> showString ("module "++mod++" not found.\n")+  where+    showMod (m,ns)  = showString m . trusted ns . nl+                      . columnate 80 (map showIdent ns) . nl+    showIdent (s,i) = (show (i_uses i), s)+    nl    = showChar '\n'+    space = showChar ' '+    times n x = foldr (.) id (replicate n x)+    trusted ((_,i):_) = if i_isTraced i then id else+                        showString (highlight [Foreground Blue] " (trusted)")+++columnate :: Int -> [(String,String)] -> ShowS+columnate width ns =+  let largestN = maximum (map (length.fst) ns)+      largestS = maximum (map (length.snd) ns)+      numitems = length ns+      numcols  = width `div` (largestN+largestS+3)+      numlines = let x = numitems `mod` numcols+                     y = numitems `div` numcols in+                 if x==0 then y else y+1+      rjust n s = replicate (n-length s) ' ' ++ s+      ljust n s = s ++ replicate (n-length s) ' '+      shown (n,s) = highlight [Foreground Blue] (rjust largestN n)+                    ++" "++ ljust largestS s+      divided :: Int -> [a] -> [[a]]+      divided n [] = []+      divided n xs = let (a,b) = splitAt n xs in a: divided n b+      -- flipped :: [[a]] -> [[a]]+      flipped xss | all null xss = []+      flipped xss = map (safe head "") xss : flipped (map (safe tail []) xss)+      safe f e xs = if null xs then e else f xs+      oneline ns rest = foldr (.) id (map showString (intersperse "  " ns))+                        . showChar '\n' . rest+  in+  foldr oneline id (flipped (divided numlines (map shown ns)))+++---------------------------------------------------------------------
+ tools/LowLevel.hs view
@@ -0,0 +1,300 @@+{-# LANGUAGE EmptyDataDecls #-}++module LowLevel+  ( openHatFile		-- :: CString -> CString -> IO ()+  , closeHatFile  -- :: IO ()+  , getBridgeValue	-- :: IO FileNode+  , getErrorLoc		-- :: IO FileNode+  , getErrorMessage	-- :: IO CString+  , hatVersionNumber	-- :: String++  , FileNode(..)+  , nil			-- :: FileNode+  , unevaluated		-- :: FileNode+  , entered		-- :: FileNode+  , interrupted		-- :: FileNode+  , lambda		-- :: FileNode+  , dolambda		-- :: FileNode++  , NodeType(..)+  , nodeType		-- :: FileNode -> NodeType+  , SimpleNodeType(..)+  , simpleNodeType	-- :: FileNode -> SimpleNodeType++  , getParentNode	-- :: FileNode -> FileNode+  , getResult		-- :: FileNode -> Bool -> FileNode+  , peekResult		-- :: FileNode -> FileNode++  , getValue		-- :: FileNode -> String+  , getValueMod		-- :: FileNode -> String+  , getFixity		-- :: FileNode -> Int+  , isLiteral		-- :: FileNode -> Bool+  , isConstructor	-- :: FileNode -> Bool+  , isConstrFields	-- :: FileNode -> Bool+  , isLambda		-- :: FileNode -> Bool+  , isDoLambda		-- :: FileNode -> Bool++  , getAtom		-- :: FileNode -> String+  , getAtomMod		-- :: FileNode -> String+  , getAtomFixity	-- :: FileNode -> Int++  , getSubExprs		-- :: FileNode -> [FileNode]+  , peekSubExprs        -- :: FileNode -> [FileNode]+  , peekExpArg          -- :: FileNode -> Int -> FileNode+  , getFieldLabels	-- :: FileNode -> [String]++  , getSrcRef		-- :: FileNode -> FileNode+  , getDefnRef		-- :: FileNode -> FileNode++  , peekTrace		-- :: FileNode -> FileNode++  , nodeSequence	-- :: IO [(FileNode,NodeType)]++  , hiddenChildren      -- :: FileNode -> [FileNode]+  ) where++import Foreign.Ptr      (Ptr)+import Foreign.C.String	(CString, peekCString)+import System.IO.Unsafe (unsafePerformIO)+import Numeric (showHex)++-- Reference into the .hat file+newtype FileNode = FileNode {int::Int}+  deriving (Eq, Ord)+instance Show FileNode where showsPrec _ (FileNode i) = showHex i+nil         = FileNode 0+unevaluated = FileNode 1+entered     = FileNode 2+interrupted = FileNode 3+lambda      = FileNode 4+dolambda    = FileNode 5++instance Num FileNode where+  (+) (FileNode x) (FileNode y) = FileNode (x+y)++-- There are 25 basic types of node, encoded in the lower 5 bits of the tag+-- They fall into four broad classes: module info, srcpos, expressions, atoms.+data NodeType+  = Module+  | SrcPos+  | ExpApp+  | ExpValueApp+  | ExpChar+  | ExpInt+  | ExpInteger+  | ExpRat+  | ExpRational+  | ExpFloat+  | ExpDouble+  | ExpValueUse+  | ExpConstUse+  | ExpConstDef+  | ExpGuard+  | ExpCase+  | ExpIf+  | ExpFieldUpdate+  | ExpProjection+  | ExpHidden+  | ExpForward+  | ExpDoStmt+  | AtomVariable+  | AtomConstructor+  | AtomAbstract+  | ListCons+  deriving (Eq,Show)++instance Enum NodeType where+  toEnum  0 = Module+  toEnum  1 = SrcPos+  toEnum  2 = ExpApp+  toEnum  3 = ExpValueApp+  toEnum  4 = ExpChar+  toEnum  5 = ExpInt+  toEnum  6 = ExpInteger+  toEnum  7 = ExpRat+  toEnum  8 = ExpRational+  toEnum  9 = ExpFloat+  toEnum 10 = ExpDouble+  toEnum 11 = ExpValueUse+  toEnum 12 = ExpConstUse+  toEnum 13 = ExpConstDef+  toEnum 14 = ExpGuard+  toEnum 15 = ExpCase+  toEnum 16 = ExpIf+  toEnum 17 = ExpFieldUpdate+  toEnum 18 = ExpProjection+  toEnum 19 = ExpHidden+  toEnum 20 = ExpForward+  toEnum 21 = ExpDoStmt+  toEnum 26 = AtomVariable+  toEnum 27 = AtomConstructor+  toEnum 28 = AtomAbstract+  toEnum 29 = ListCons+  toEnum n  = error ("NodeType.toEnum "++show n)++-- For most purposes, we don't care about the exact node type, and a+-- simplified division of nodes into kinds is useful.+data SimpleNodeType+  = NodeModule		-- Module+  | NodeSrcPos		-- SrcPos+  | NodeApplication	-- ExpApp, ExpValueApp+  | NodeBasicValue	-- ExpChar, ExpInt, ..., ExpDouble+  | NodeIdentifier	-- ExpValueUse+  | NodeCAF		-- ExpConstUse, ExpConstDef+  | NodeConditional	-- ExpGuard, ExpCase, ExpIf+  | NodeSugar		-- ExpFieldUpdate, ExpDoStmt+  | NodeSpecial		-- ExpProjection, ExpHidden, ExpForward+  | NodeAtom		-- AtomVariable, AtomConstructor, AtomAbstract+  | NodeList            -- ListCons+  deriving (Eq)+++-- For opening files, and and collecting values from the bridge file.+foreign import ccall "artutils.h" openHatFile    :: CString -> CString -> IO ()+foreign import ccall "artutils.h" closeHatFile   :: IO ()+foreign import ccall "artutils.h" getBridgeValue :: IO FileNode+foreign import ccall "artutils.h" getErrorLoc    :: IO FileNode+foreign import ccall "artutils.h" errorMessage   :: IO CString+foreign import ccall "artutils.h" versionNumber  :: IO CString+getErrorMessage  :: IO String+getErrorMessage = do msg <- errorMessage+                     peekCString msg+hatVersionNumber :: String+hatVersionNumber = unsafePerformIO $ do num <- versionNumber+                                        peekCString num+++-- Find out what node type we have a reference to.+nodeType :: FileNode -> NodeType+nodeType n = toEnum (getNodeType n)+foreign import ccall "artutils.h" getNodeType   :: FileNode -> Int++-- Give a simple node type to a reference.+simpleNodeType :: FileNode -> SimpleNodeType+simpleNodeType n =+    case nodeType n of+      Module -> NodeModule+      SrcPos -> NodeSrcPos+      ExpApp      -> NodeApplication+      ExpValueApp -> NodeApplication+      ExpValueUse -> NodeIdentifier+      ExpConstUse -> NodeCAF+      ExpConstDef -> NodeCAF+      ExpFieldUpdate -> NodeSugar+      ExpDoStmt      -> NodeSugar+      ExpGuard -> NodeConditional+      ExpCase  -> NodeConditional+      ExpIf    -> NodeConditional+      ExpProjection -> NodeSpecial+      ExpHidden     -> NodeSpecial+      ExpForward    -> NodeSpecial+      AtomVariable    -> NodeAtom+      AtomConstructor -> NodeAtom+      AtomAbstract    -> NodeAtom+      ListCons -> NodeList+      _  -> NodeBasicValue++-- For any node type, get its parent.  If it doesn't have one, the+-- zero node is returned.+foreign import ccall "artutils.h" parentNode :: FileNode -> FileNode+getParentNode :: FileNode -> FileNode+getParentNode n = peekTrace (parentNode n)++-- For any node, return its result pointer.  Only an application, CAF,+-- case/if/guard, field update, or hidden node actually has one - in all+-- other cases we get back 0.  The Boolean denotes whether to stop at+-- the first Hidden node.+foreign import ccall "artutils.h" getResult     :: FileNode -> Bool -> FileNode++-- Because getResult stops one link in the chain *before* an Unevaluated,+-- Entered, Interrupted, or Lambda node, peekResult looks just one step+-- down the result chain.+foreign import ccall "artutils.h" peekResult    :: FileNode -> FileNode++-- For nodes of value kind, we get back a string representation of the value+-- (Integer, Double etc) or name (identifier, constructor, etc),+-- and its fixity.  The predicate isLiteral reports True for values of basic+-- types like Int, Char, Double etc, and isConstructor identifies Constrs.+-- The predicate isLambda can only be used on an ExpValueUse node.+foreign import ccall "artutils.h" getNm         :: FileNode -> CString+foreign import ccall "artutils.h" getNmMod      :: FileNode -> CString+foreign import ccall "artutils.h" getFixity     :: FileNode -> Int+foreign import ccall "artutils.h" isLiteral     :: FileNode -> Bool+foreign import ccall "artutils.h" isConstructor :: FileNode -> Bool+foreign import ccall "artutils.h" isConstrFields:: FileNode -> Bool+foreign import ccall "artutils.h" isLambda      :: FileNode -> Bool+foreign import ccall "artutils.h" isDoLambda    :: FileNode -> Bool+getValue :: FileNode -> String+getValue n = unsafePerformIO (peekCString (getNm n))+getValueMod :: FileNode -> String+getValueMod n = unsafePerformIO (peekCString (getNmMod n))++data Atom;+foreign import ccall "artutils.h" readAtomAt    :: FileNode -> Ptr Atom+foreign import ccall "artutils.h" identName     :: Ptr Atom -> CString+foreign import ccall "artutils.h" identModName  :: Ptr Atom -> CString+foreign import ccall "artutils.h" identFixity   :: Ptr Atom -> Int+getAtom :: FileNode -> String+getAtom n = unsafePerformIO (peekCString (identName (readAtomAt n)))+getAtomMod :: FileNode -> String+getAtomMod n = unsafePerformIO (peekCString (identModName (readAtomAt n)))+getAtomFixity :: FileNode -> Int+getAtomFixity n = identFixity (readAtomAt n)++-- For Trace nodes excluding kind TNm, get any argument *values*.+getSubExprs :: FileNode -> [FileNode]+getSubExprs n = let arity = getExpArity n+                in (map (getExpArg n) [0..arity])+foreign import ccall "artutils.h" getExpArity   :: FileNode -> Int+foreign import ccall "artutils.h" getExpArg     :: FileNode -> Int -> FileNode++-- get all argument expressions (or atoms)+peekSubExprs :: FileNode -> [FileNode]+peekSubExprs n = let arity = getExpArity n+                 in (map (peekExpArg n) [0..arity])+foreign import ccall "artutils.h" peekExpArg    :: FileNode -> Int -> FileNode++-- For a ExpFieldUpdate node only, get the list of updated labels.+getFieldLabels :: FileNode -> [String]+getFieldLabels n = let arity = getExpArity n+                   in map (getAtom . getFieldLabel n) [0..(arity-1)]+foreign import ccall "artutils.h" getFieldLabel :: FileNode -> Int -> FileNode+++-- For any node type, get its source reference.  If it doesn't have one,+-- we get a null pointer (0) back.+foreign import ccall "artutils.h" getSrcRef     :: FileNode -> FileNode++-- For a variable, constructor, or application, get the Atom node that+-- contains its definition information.  If it isn't a variable,+-- constructor, or application, we get a null pointer (0) back.+foreign import ccall "artutils.h" getDefnRef    :: FileNode -> FileNode+++-- Look past any SATs, indirections, or hidden nodes, to `real' trace.+foreign import ccall "artutils.h" peekTrace     :: FileNode -> FileNode+++-- Lazily return the complete sequence of node addresses and their types+nodeSequence :: IO [(FileNode,NodeType)]+nodeSequence = do q_init; list '0'+  where list _ = do n  <- currentfilepos+                    c' <- q_peek+                    c  <- q_tag+                    q_skipNode c' +                    if c=='\31' then return []	-- end of file+                      else return ((FileNode n, toEnum (fromEnum c))+                                  : unsafePerformIO (list c))+foreign import ccall "artutils.h" q_init         :: IO ()+foreign import ccall "artutils.h" currentfilepos :: IO Int+foreign import ccall "artutils.h" q_peek         :: IO Char+foreign import ccall "artutils.h" q_tag          :: IO Char+foreign import ccall "artutils.h" q_skipNode     :: Char -> IO Int++hiddenChildren :: FileNode -> [FileNode]+-- assumes given FileNode is Hidden node+-- gives list of all children, possibly empty.+hiddenChildren hidden = go (peekExpArg hidden 1)+  where+  go node = if node == nil then [] +                           else peekExpArg node 1 : go (peekExpArg node 2)
+ tools/NodeExp.hs view
@@ -0,0 +1,992 @@+-- Very Simple Expression (SExps, but even more simple!)+module NodeExp+  (NodeExp(..),(===),isIn,isomorphicIn,branches+  ,CondType(..)+  ,nodeExpForNode,result,finalResult,isDataConstructor+  ,compressClosures+  ,removeResultCycles,limitDepth+  ,fullEval,cutoffEval,condEval,flatEval,singleStepEval+  ,fullEvalText,flatEvalText+  ,children,findAppsMatching+  ,hideFunction+--  ,expandFunction+  ,nodeExp2SExp,removeNonResultCycles+  ,getNode,getFirstCaredNode+  ) where++import LowLevel hiding    ( nil )+import qualified LowLevel ( nil )+import Data.List          ( elemIndex , nub , null )+import SExp               ( SExp (..), SFixity(..), transFixity, QName(..)+                          , showQN, prettySExp)+import CommonUI           (Options(..),Keep(..))+import Explore            (redexParent)++import Data.List          ((\\))+import System.IO.Unsafe   (unsafePerformIO)++data CondType = IfCond | CaseCond | GuardCond deriving (Eq, Show)++-- Represents an ART file in it's raw form+data NodeExp+  = NExpApp         FileNode NodeExp [NodeExp] NodeExp+  | NExpConstUse    FileNode QName NodeExp+  | NExpConstDef    FileNode QName NodeExp+  | NExpIdentifier  FileNode QName SFixity+  | NExpConstructor FileNode QName SFixity+  | NExpLiteral     FileNode String+  | NExpCond        FileNode CondType NodeExp NodeExp+  | NExpFieldExp    FileNode NodeExp [(String, NodeExp)]+  | NExpProjection  FileNode NodeExp+  | NExpForward     FileNode NodeExp+  | NExpHidden      FileNode [NodeExp] NodeExp+  | NExpInterrupt+  | NExpUneval+  | NExpBottom+  | NExpNotShown+  | NExpResultCycle FileNode+  | NExpNonResultCycle FileNode+  -- An expanded function+  | NExpExpanded   FileNode [NodeExp]+  --deriving Show++data Infinite a = Inf+                | Num a deriving Eq++instance Ord a => Ord (Infinite a) where+  compare (Num x) (Num y) = compare x y+  compare (Num x) Inf = LT+  compare Inf (Num x) = GT+  compare Inf Inf = EQ++instance Show NodeExp where+  show (NExpApp n _ _ _)       = "App " ++ show n+  show (NExpConstUse n _ _)    = "ConstUse " ++ show n+  show (NExpConstDef n _ _)    = "ConstDef " ++ show n+  show (NExpIdentifier _ _ _)  = "ID"+  show (NExpConstructor _ _ _) = "Cons"+  show (NExpLiteral _ _)       = "Lit"+  show (NExpCond _ _ _ _)      = "Cond"+  show (NExpFieldExp _ _ _)    = "Field Exp"+  show (NExpProjection _ _)    = "Proj"+  show (NExpForward _ _)       = "Forw"+  show (NExpHidden n _ _)      = "Hid " ++ show n+  show NExpInterrupt           = "Int"+  show NExpUneval              = "Uneval"+  show NExpBottom              = "_|_"+  show NExpNotShown            = "NS"+  show (NExpResultCycle n)     = "RC" ++ show n+  show (NExpExpanded n _)      = "Expa" ++ show n++instance Eq NodeExp where+  (==) exp1 exp2+    = if isSimpleNodeType exp1 || isSimpleNodeType exp2+        then simpleComp exp1 exp2+        else (getNode exp1) == (getNode exp2)++instance Ord NodeExp where+  compare exp1 exp2+    = if isSimpleNodeType exp1+        then if isSimpleNodeType exp2+               then EQ+               else LT+        else if isSimpleNodeType exp2+               then GT+               else compare (getNode exp1) (getNode exp2)++branches :: NodeExp -> [NodeExp]+branches (NExpApp _ f as r) = f:r:as+branches (NExpConstUse _ _ r) = [r]+branches (NExpConstDef _ _ r) = [r]+branches (NExpCond _ _ c r) = [c,r]+branches (NExpFieldExp _ e ms) = e:(map snd ms)+branches (NExpProjection _ r) = [r]+branches (NExpForward _ r) = [r]+branches (NExpHidden _ c r) = r:c+branches _ = []++isDataConstructor :: NodeExp -> Bool+isDataConstructor (NExpIdentifier n na f) = False+isDataConstructor (NExpConstructor n na f) = True+isDataConstructor x+  | hasResult x = isDataConstructor (result x)+  | otherwise   = False++isIn :: NodeExp -> NodeExp -> Bool+isIn x y = gIn (==) x y++isomorphicIn :: NodeExp -> NodeExp -> Bool+isomorphicIn x y = gIn (===) x y++gIn :: (NodeExp -> NodeExp -> Bool) -> NodeExp -> NodeExp -> Bool+gIn f x y | x `f` y = True+gIn f x (NExpApp _ fun args res)+  =    gIn f x fun+    || any (gIn f x) args+    || gIn f x res+gIn f x (NExpConstUse _ _ res)+  = gIn f x res+gIn f x (NExpConstDef _ _ res)+  = gIn f x res+gIn f x (NExpCond _ _ cond res)+  = gIn f x cond || gIn f x res+gIn f x (NExpFieldExp _ _ mappings)+  = any (gIn f x . snd) mappings+gIn f x (NExpProjection _ res)+  = gIn f x res+gIn f x (NExpForward _ res)+  = gIn f x res+gIn f x (NExpHidden _ children res)+  =    (any (gIn f x) children)+    || gIn f x res+gIn _ _ _ = False++(===) :: NodeExp -> NodeExp -> Bool+(NExpApp _ fun args res) === (NExpApp _ fun2 args2 res2)+  = (fun === fun2) && (and $ zipWith (===) args args2) && (res === res2)+(NExpConstUse _ name res) === (NExpConstUse _ name2 res2)+  = (name == name2) && (res === res2)+(NExpConstDef _ name res) === (NExpConstDef _ name2 res2)+  = (name == name2) && (res === res2)+(NExpIdentifier _ name _) === (NExpIdentifier _ name2 _)+  = (name == name2)+(NExpConstructor _ name _) === (NExpConstructor _ name2 _)+  = (name == name2)+(NExpLiteral _ value) === (NExpLiteral _ value2)+  = value == value2+(NExpCond _ condType cond res) === (NExpCond _ condType2 cond2 res2)+  = (condType == condType2) && (cond === cond2) && (res === res2)+(NExpFieldExp _ name mappings) === (NExpFieldExp _ name2 mappings2)+  = (name == name2) && (and $ zipWith (\x y -> (fst x == fst y) && (snd x === snd y)) mappings mappings2)+(NExpProjection _ res) === (NExpProjection _ res2)+  = res === res2+(NExpHidden _ children res) === (NExpHidden _ children2 res2)+  = (and $ zipWith (===) children children2) && res === res2+(NExpForward _ res) === (NExpForward _ res2)+  = res === res2+(NExpExpanded _ apps) === (NExpExpanded _ apps2)+  = all id $ zipWith (===) apps apps2+NExpResultCycle _ === NExpResultCycle _ = True+NExpNonResultCycle _ === NExpNonResultCycle _ = True+NExpInterrupt === NExpInterrupt = True+NExpUneval === NExpUneval = True+NExpBottom === NExpBottom = True+NExpNotShown === NExpNotShown = True+_ === _ = False++getNode :: NodeExp -> FileNode+getNode (NExpApp node _ _ _) = node+getNode (NExpConstUse node _ _) = node+getNode (NExpConstDef node _ _) = node+getNode (NExpIdentifier node _ _) = node+getNode (NExpConstructor node _ _) = node+getNode (NExpCond node _ _ _) = node+getNode (NExpFieldExp node _ _) = node+getNode (NExpProjection node _) = node+getNode (NExpForward node _) = node+getNode (NExpHidden node _ _) = node+getNode (NExpResultCycle node) = node+getNode _ = LowLevel.nil++isSimpleNodeType :: NodeExp -> Bool+isSimpleNodeType NExpInterrupt = True+isSimpleNodeType NExpBottom = True+isSimpleNodeType NExpNotShown = True+isSimpleNodeType (NExpResultCycle _) = True+isSimpleNodeType _ = False++hasResult :: NodeExp -> Bool+hasResult NExpInterrupt = False+hasResult NExpUneval = False+hasResult NExpBottom = False+hasResult NExpNotShown = False+hasResult (NExpResultCycle _) = False+hasResult (NExpIdentifier _ _ _) = False+hasResult (NExpConstructor _ _ _) = False+hasResult (NExpLiteral _ _) = False+hasResult (NExpFieldExp _ _ _) = False+hasResult _ = True++result :: NodeExp -> NodeExp+result (NExpApp _ _ _ res) = res+result (NExpConstUse _ _ res) = res+result (NExpConstDef _ _ res) = res+result (NExpCond _ _ _ res) = res+result (NExpProjection _ res) = res+result (NExpForward _ res) = res+result (NExpHidden _ _ res) = res+result x = x++finalResult :: NodeExp -> NodeExp+finalResult (NExpApp _ _ _ res) = finalResult res+finalResult (NExpConstUse _ _ res) = finalResult res+finalResult (NExpConstDef _ _ res) = finalResult res+finalResult (NExpCond _ _ _ res) = finalResult res+finalResult (NExpProjection _ res) = finalResult res+finalResult (NExpForward _ res) = finalResult res+finalResult (NExpHidden _ _ res) = finalResult res+finalResult x = x++simpleComp :: NodeExp -> NodeExp -> Bool+simpleComp NExpInterrupt NExpInterrupt = True+simpleComp NExpBottom NExpBottom = True+simpleComp NExpNotShown NExpNotShown = True+simpleComp (NExpResultCycle x) (NExpResultCycle y) = x == y+simpleComp _ _ = False++nodeExpForNode :: FileNode -> NodeExp+nodeExpForNode node =+--  seq (unsafePerformIO $ putStrLn $ ("NodExp: " ++ show node)) $ +  if node == LowLevel.unevaluated then NExpUneval+  else if node == LowLevel.entered then NExpBottom+  else if node == LowLevel.interrupted then NExpInterrupt+  else if node == LowLevel.nil then NExpNotShown+  else+    case simpleNodeType node of+      NodeAtom ->+        case nodeType node of+          AtomConstructor ->+            NExpConstructor node+                            (Qualified (getAtomMod node) (getAtom node))+                            (transFixity (getAtomFixity node))+          _ ->+            NExpIdentifier node+                           (Qualified (getAtomMod node) (getAtom node))+                           (transFixity (getAtomFixity node))+      NodeApplication ->+        NExpApp node funExp argExps resExp+        where+          funExp = nodeExpForNode function+          argExps = map nodeExpForNode args+          resExp = nodeExpForNode (peekResult node)+          (function:args) = peekSubExprs node+      NodeBasicValue ->+        NExpLiteral node (getValue node)+      NodeCAF ->+        case nodeType node of+          ExpConstUse ->+            NExpConstUse node+                         (Qualified (getValueMod node) (getValue node))+                         (nodeExpForNode $ peekResult node)+          ExpConstDef ->+            NExpConstDef node+                         (Qualified (getValueMod node)+                                    (getValue node))+                         (nodeExpForNode $ peekResult node)+      NodeConditional ->+        let+          condType = case nodeType node of+            ExpIf -> IfCond+            ExpCase -> CaseCond+            ExpGuard -> GuardCond+        in+          NExpCond node+                   condType+                   (nodeExpForNode (mHead "NodeConditional" (peekSubExprs node)))+                   (nodeExpForNode (peekResult node))+      NodeIdentifier->+        NExpIdentifier node+                       (Qualified mod id)+                       (grabFixity mod id)+        where+          mod = getValueMod node+          id = getValue node+          grabFixity m i =+            case i of+              "."   | m == "Prelude" -> SAssoc 9 i+              "++"  | m == "Prelude" -> SAssoc 5 i+              "&&"  | m == "Prelude" -> SAssoc 3 i+              "||"  | m == "Prelude" -> SAssoc 2 i+              "*"   | m == "Prelude" -> SAssoc 7 i+              "+"   | m == "Prelude" -> SAssoc 6 i+              ">>"  | m == "Prelude" -> SAssoc 1 i+              ">>=" | m == "Prelude" -> SAssoc 1 i+              _                      -> transFixity (getFixity node)+      NodeSpecial ->+        case nodeType node of+          ExpProjection ->+            NExpProjection node+                           (nodeExpForNode (peekResult node))+          ExpHidden ->+            NExpHidden node+                       (map nodeExpForNode $ hiddenChildren node)+                       (nodeExpForNode (peekResult node))+          ExpForward ->+            NExpForward node (nodeExpForNode (peekResult node))+      NodeSugar ->+        case nodeType node of+          ExpDoStmt ->+            NExpLiteral node "{do stmt}"+          ExpFieldUpdate ->+            NExpFieldExp node exp (zip (getFieldLabels node) range)+            where+              (exp:range) = map nodeExpForNode (peekSubExprs node)++removeResultCycles :: NodeExp -> NodeExp+removeResultCycles = remCycles []+  where+    remCycles :: [FileNode] -> NodeExp -> NodeExp+    remCycles xs e@(NExpApp node fun args res)+      = -- seq (unsafePerformIO $ putStrLn ("remCycles: " ++ show e)) $+        if node `elem` xs+          then (NExpResultCycle (getNode res))+          else NExpApp node+                       (remCycles (node:xs) fun)+                       (map (remCycles (node:xs)) args)+                       (remCycles (node:xs) res)+    remCycles xs e@(NExpConstUse node def res)+      = -- seq (unsafePerformIO $ putStrLn ("remCycles: " ++ show e)) $+        if  node `elem` xs+          then (NExpResultCycle (getNode res))+          else NExpConstUse node def (remCycles (node:xs) res)+    remCycles xs e@(NExpConstDef node def res)+      = -- seq (unsafePerformIO $ putStrLn ("remCycles: " ++ show e)) $+        if  node `elem` xs+          then (NExpResultCycle (getNode res))+          else NExpConstDef node def (remCycles (node:xs) res)+    remCycles xs e@(NExpCond node condType cond res)+      = -- seq (unsafePerformIO $ putStrLn ("remCycles: " ++ show e)) $+        if node `elem` xs+          then (NExpResultCycle (getNode res))+          else NExpCond node+                        condType+                        (remCycles (node:xs) cond)+                        (remCycles (node:xs) res)+    remCycles xs e@(NExpProjection node res)+      = -- seq (unsafePerformIO $ putStrLn ("remCycles: " ++ show e)) $+        if node `elem` xs+          then (NExpResultCycle (getNode res))+          else NExpProjection node+                              (remCycles (node:xs) res)+    remCycles xs e@(NExpForward node res)+      = -- seq (unsafePerformIO $ putStrLn ("remCycles: " ++ show e)) $+        if node `elem` xs+          then (NExpResultCycle (getNode res))+          else NExpForward node (remCycles (node:xs) res)+    remCycles xs e@(NExpHidden node children res)+      = -- seq (unsafePerformIO $ putStrLn ("remCycles: " ++ show e)) $+        if node `elem` xs+          then (NExpResultCycle (getNode res))+          else NExpHidden node+                          (map (remCycles (node:xs)) children)+                          (remCycles (node:xs) res)+    remCycles xs e@(NExpFieldExp node exp mappings)+      = -- seq (unsafePerformIO $ putStrLn ("remCycles: " ++ show e)) $+        NExpFieldExp node (remCycles (node:xs) exp) (map remCycs mappings)+        where+          remCycs :: (String, NodeExp) -> (String, NodeExp)+          remCycs (x,y) = (x, remCycles (node:xs) y)+    remCycles xs y = y++limitDepth :: Int -> NodeExp -> NodeExp+limitDepth 0 _ = NExpNotShown+limitDepth n (NExpApp node fun args res)+  = NExpApp node+            (limitDepth (n-1) fun)+            (map (limitDepth (n-1)) args)+            (limitDepth (n-1) res)+limitDepth n (NExpConstUse node def res)+  = NExpConstUse node def (limitDepth (n-1) res)+limitDepth n (NExpConstDef node def res)+  = NExpConstDef node def (limitDepth (n-1) res)+limitDepth n (NExpCond node condType cond res)+  = NExpCond node+             condType+             (limitDepth (n-1) cond)+             (limitDepth (n-1) res)+limitDepth n (NExpFieldExp node exp mappings)+  = NExpFieldExp node (limitDepth (n-1) exp) (map limitMapDepth mappings)+    where+      limitMapDepth :: (String, NodeExp) -> (String, NodeExp)+      limitMapDepth (x, y) = (x, limitDepth (n-1) y)+limitDepth n (NExpProjection node res)+  = NExpProjection node (limitDepth (n-1) res)+limitDepth n (NExpForward node res)+  = NExpForward node (limitDepth (n-1) res)+limitDepth n (NExpHidden node children res)+  = NExpHidden node+               (map (limitDepth (n-1)) children)+               (limitDepth (n-1) res)+limitDepth n x = x++compressClosures :: NodeExp -> NodeExp+compressClosures (NExpApp node+                          (NExpApp innerNode innerFun innerArgs innerRes)+                          args+                          res) =+  NExpApp node+          innerFun+          (map compressClosures (innerArgs ++ args))+          (compressClosures res)+compressClosures (NExpApp node fun args res) =+  NExpApp node+          (compressClosures fun)+          (map compressClosures args)+          (compressClosures res)+compressClosures (NExpConstUse node def res) =+  NExpConstUse node def (compressClosures res)+compressClosures (NExpConstDef node def res) =+  NExpConstDef node def (compressClosures res)+compressClosures (NExpCond node condType cond res) =+  NExpCond node+           condType+           (compressClosures cond)+           (compressClosures res)+compressClosures (NExpFieldExp node exp mappings) =+  NExpFieldExp node+               (compressClosures exp)+               (map compressMapping mappings)+  where+    compressMapping :: (String, NodeExp) -> (String, NodeExp)+    compressMapping (x, y) = (x, compressClosures y)+compressClosures (NExpProjection node res) =+  NExpProjection node (compressClosures res)+compressClosures (NExpForward node res) =+  NExpForward node (compressClosures res)+compressClosures (NExpHidden node children res) =+  NExpHidden node+             (map compressClosures children)+             (compressClosures res)+compressClosures x = x++expText :: Int -> NodeExp -> String+expText w = (prettySExp "" w (Options {cutoffDepth=30+                                      ,unevalMode=False+                                      ,stringSugar=True+                                      ,listSugar=True+                                      ,recursiveMode=True+                                      ,colourBracks=False+                                      ,equations=True+                                      ,showQual=False+                                      ,filterMode=Unique})) .+            nodeExp2SExp . removeNonResultCycles++flatEvalText :: Int -> NodeExp -> String+flatEvalText w = (expText w) . (flatEval fullEval)++fullEvalText :: Int -> NodeExp -> String+fullEvalText w = (expText w) . fullEval++fullEval :: NodeExp -> NodeExp+fullEval = condEval (\x -> (not $ isCycle x) && (not $ isTotallyHidden x))++isTotallyHidden :: NodeExp -> Bool+isTotallyHidden exp =+  case res of+    NExpResultCycle n    -> let nType = nodeType n+                            in nType /= ExpValueApp && nType /= ExpApp+    NExpNonResultCycle n -> let nType = nodeType n+                            in nType /= ExpValueApp && nType /= ExpApp+    _                    -> False+  where+    res = finalResult exp++isCycle :: NodeExp -> Bool+isCycle (NExpResultCycle _) = True+isCycle (NExpNonResultCycle _) = True+isCycle _ = False+{-  | not (hasResult exp) = True+  | otherwise+    = case result exp of+        NExpResultCycle _ -> False+        _                 -> True -}++flatEval :: (NodeExp -> NodeExp) -> NodeExp -> NodeExp+flatEval buildSubs (NExpApp node fun args res)+  = NExpApp node funExp argExps resExp+      where+        funExp = case fun of+                   (NExpApp _ _ _ _) -> flatEval buildSubs fun+                   _                 -> buildSubs fun+        argExps = map buildSubs args+        resExp = buildSubs res+flatEval buildSubs (NExpConstUse node def res)+  = NExpConstUse node def (buildSubs res)+flatEval buildSubs (NExpConstDef node def res)+  = NExpConstDef node def (buildSubs res)+flatEval buildSubs (NExpCond node condType cond res)+  = NExpCond node condType (buildSubs cond) (buildSubs res)+flatEval buildSubs (NExpFieldExp node exp mappings)+  = NExpFieldExp node procExp procMappings+      where+        procExp = buildSubs exp+        procMappings = map buildSub mappings+        buildSub :: (String, NodeExp) -> (String, NodeExp)+        buildSub (x, y) = (x, buildSubs y)+flatEval buildSubs (NExpProjection node res)+  = buildSubs res+flatEval buildSubs (NExpForward node res)+  = buildSubs res+flatEval buildSubs (NExpHidden node children res)+  = NExpLiteral node "{?}"+flatEval _ x = x++-- Will chase result pointers until it hits the specified offest.+cutoffEval :: FileNode -> NodeExp -> NodeExp+cutoffEval cutoff node = condEval (lessThanEqNode cutoff) node++singleStepEval :: NodeExp -> NodeExp+singleStepEval node =+  n+  where+    (n,t) = singleStepEval' t node+    +    singleStepEval' :: Infinite FileNode+                    -> NodeExp+                    -> (NodeExp, Infinite FileNode)+    singleStepEval' c (NExpApp n f as r) =+      case r of+        NExpResultCycle _ ->+          (NExpApp n fe ase re, minimum (fm:rm:asm))+        _                 ->+          (if (Num n) <= c then re else NExpApp n fe ase re+          ,minimum ((Num n):fm:rm:asm))+      where+        (fe,fm) = singleStepEval' c f+        (ase,asm) = unzip . map (singleStepEval' c) $ as+        (re,rm) = singleStepEval' c r+    singleStepEval' c (NExpConstUse n nm r) = singleStepEval' c r+    singleStepEval' c (NExpConstDef n nm r) = singleStepEval' c r+    singleStepEval' c (NExpCond n t cn r) =+      case r of+        NExpResultCycle _ ->+          (NExpCond n t cne re, min cnm rm)+        _                 ->+          (if (Num n) <= c then re else NExpCond n t cne re+          ,min (Num n) (min cnm rm))+      where+        (cne,cnm) = singleStepEval' c cn+        (re,rm) = singleStepEval' c r+    singleStepEval' c (NExpFieldExp n e m) =+      (NExpFieldExp n ee (zip (map fst m) me), minimum (em:mm))+      where+        (ee,em) = singleStepEval' c e+        (me,mm) = unzip . map (singleStepEval' c . snd) $ m+    singleStepEval' c (NExpProjection n r) = singleStepEval' c r+    singleStepEval' c (NExpForward n r)    = singleStepEval' c r+    singleStepEval' c (NExpHidden _ _ r)   = singleStepEval' c r+    singleStepEval' c exp = (exp, Inf)++lessThanEqNode :: FileNode -> NodeExp -> Bool+lessThanEqNode node (NExpResultCycle _) = False+lessThanEqNode node exp+  = if caredNode == Nothing then True+    else (unMaybe caredNode) <= node+    where+      caredNode = (getFirstCaredNode exp)++unMaybe :: Maybe a -> a+unMaybe (Just x) = x++fetchOffset :: NodeExp -> FileNode+fetchOffset (NExpApp node _ _ _) = node+fetchOffset (NExpConstUse node _ _) = node+fetchOffset (NExpConstDef node _ _) = node+fetchOffset (NExpIdentifier node _ _) = node+fetchOffset (NExpConstructor node _ _) = node+fetchOffset (NExpLiteral node _) = node+fetchOffset (NExpCond node _ _ _) = node+fetchOffset (NExpFieldExp node _ _) = node+fetchOffset (NExpProjection node _) = node+fetchOffset (NExpForward _ res) = fetchOffset res+fetchOffset (NExpHidden node _ _) = node++getFirstCaredNode :: NodeExp -> Maybe FileNode+getFirstCaredNode (NExpApp node _ _ res)+  = case res of+      (NExpResultCycle _)   -> Nothing+      NExpUneval            -> Nothing+      otherwise             -> Just node+getFirstCaredNode (NExpConstUse node _ res)+  = case res of+      (NExpResultCycle _)   -> Nothing+      NExpUneval            -> Nothing+      otherwise             -> Just node+getFirstCaredNode (NExpConstDef node _ res)+  = case res of+      (NExpResultCycle _)   -> Nothing+      NExpUneval            -> Nothing+      otherwise             -> Just node+getFirstCaredNode (NExpIdentifier node _ _) = Just node+getFirstCaredNode (NExpConstructor node _ _) = Just node+getFirstCaredNode (NExpLiteral node _) = Just node+getFirstCaredNode (NExpCond node _ _ _) = Just node+getFirstCaredNode (NExpFieldExp node _ _) = Just node+getFirstCaredNode (NExpProjection node _) = Just node+getFirstCaredNode (NExpForward _ res) = getFirstCaredNode res+getFirstCaredNode (NExpHidden _ _ res) = getFirstCaredNode res+getFirstCaredNode _ = Nothing++-- Will chase result pointers until the predicate passed returns False.+condEval :: (NodeExp -> Bool) -> NodeExp -> NodeExp+condEval pred nExp@(NExpApp node fun args res)+  = if pred res+      then condEval pred res+      else NExpApp node+                   (condEval pred fun)+                   (map (condEval pred) args)+                   (condEval pred res)+condEval pred nExp@(NExpConstUse node def res)+  = if pred res+      then condEval pred res+      else NExpConstUse node def (condEval pred res)+condEval pred nExp@(NExpConstDef node def res)+  = if pred res+      then condEval pred res+      else NExpConstDef node def (condEval pred res)+condEval pred nExp@(NExpCond node condType cond res)+  = if pred res+      then condEval pred res+      else NExpCond node+                    condType+                    (condEval pred cond)+                    (condEval pred res)+condEval pred nExp@(NExpFieldExp node exp mappings)+  = NExpFieldExp node evalExp evalMappings+    where+      evalExp = condEval pred exp+      evalMappings = map evalMapping mappings+      evalMapping :: (String, NodeExp) -> (String, NodeExp)+      evalMapping (x,y) = (x, condEval pred y)+condEval pred nExp@(NExpProjection node res)+  = condEval pred res+condEval pred nExp@(NExpForward _ res)+  = condEval pred res+condEval pred nExp@(NExpHidden node children res)+  = if pred res+      then condEval pred res+      else NExpHidden node+                      (map (condEval pred) children)+                      (condEval pred res)+condEval _ x = x++{-cutoffFindMinOffset :: FileNode -> NodeExp -> Maybe FileNode+cutoffFindMinOffset cutoff node+  = if offsets == [] then Nothing+    else Just (minimum offsets)+    where offsets = (map fetchOffset+                         (filter (not . isSimpleNodeType)+                                 (cutoffFindNodes cutoff node)))++cutoffFindNodes :: FileNode -> NodeExp -> [NodeExp]+cutoffFindNodes cutoff = condFindNodes (lessThanEqNode cutoff)++condFindNodes :: (NodeExp -> Bool) -> NodeExp -> [NodeExp]+condFindNodes pred nExp@(NExpApp _ fun args res)+  = if pred nExp+      then ((condFindNodes pred res) ++ (condFindNodes pred fun)+            ++ (foldr ((++) . (condFindNodes pred)) [] args))+      else [nExp]+condFindNodes pred nExp@(NExpConstUse _ def res)+  = if pred nExp+      then condFindNodes pred res+      else [nExp]+condFindNodes pred nExp@(NExpConstDef _ def res)+  = if pred nExp+      then condFindNodes pred res+      else [nExp]+condFindNodes pred nExp@(NExpCond _ condType cond res)+  = if pred nExp+      then (condFindNodes pred res) ++ (condFindNodes pred cond)+      else [nExp]+condFindNodes pred nExp@(NExpFieldExp _ exp mappings)+  = if pred nExp+      then (condFindNodes pred exp)+            ++ (foldr ((++) . (condFindNodes pred) . snd) [] mappings)+      else [nExp]+condFindNodes pred nExp@(NExpProjection _ res)+  = (condFindNodes pred res)+condFindNodes pred nExp@(NExpForward _ res)+  = (condFindNodes pred res)+condFindNodes pred nExp@(NExpHidden _ children res)+  = if pred nExp+      then (   (condFindNodes pred res)+            ++ (foldr ((++) . (condFindNodes pred)) [] children))+      else [nExp]+condFindNodes pred x = if pred x then [] else [x]-}++-- Trusts a function i.e. follows the result pointer for each application+-- of the function and replaces the node.  The result VSExp is created using+-- the import function.+hideFunction :: String -> NodeExp -> NodeExp+-- Hiding requires three conditions:+--  1. The function part of an application is fully evaluated+--  2. The names of the function is that being hidden+--  3. The node is not a value application+-- If this is met, we remove the app and replace with it's result, otherwise+-- we leave the expression as is and recurse.+hideFunction name app@(NExpApp node fun@(NExpIdentifier _ funName fix) args res)+  = if ((showQN True funName) == name || (showQN False funName) == name)+       && nodeType node /= ExpValueApp+      then hideFunction name res+      else NExpApp node+                   fun+                   (map (hideFunction name) args)+                   (hideFunction name res)+hideFunction name app@(NExpApp node fun args res)+  = NExpApp node+            (hideFunction name fun)+            (map (hideFunction name) args)+            (hideFunction name res)+hideFunction "if" ifCon@(NExpCond node IfCond _ res)+  = hideFunction "if" res+hideFunction "case" ifCon@(NExpCond node CaseCond _ res)+  = hideFunction "case" res+hideFunction "|" ifCon@(NExpCond node GuardCond cond res)+  = hideFunction "|" res+hideFunction name ifCon@(NExpCond node condType cond res)+  = NExpCond node condType (hideFunction name cond) (hideFunction name res)+hideFunction name fieldExp@(NExpFieldExp node exp mappings)+  = NExpFieldExp node (hideFunction name exp) (map hideMapping mappings)+    where+      hideMapping :: (String, NodeExp) -> (String, NodeExp)+      hideMapping (x, y) = (x, hideFunction name y)+hideFunction _ x = x++{-expandFunction :: NodeExp -> NodeExp -> NodeExp+expandFunction f a@(NExpApp off g as r) =+  NExpApp off (replaceIDs f maps g) (map (replaceIDs f maps) as) r+  where+    maps = applications f r+    replaceIDs f maps id@(NExpIdentifier off na fix)+      | id == f = NExpExpanded (getNode g) maps+      | otherwise+        = NExpIdentifier off na fix+    replaceIDs f maps (NExpApp off g as r) =+      NExpApp off (replaceIDs f maps g) (map (replaceIDs f maps) as) r+    replaceIDs f maps (NExpConstUse off n r) =+      NExpConstUse off n (replaceIDs f maps r)+    replaceIDs f maps (NExpConstDef off n r) =+      NExpConstDef off n (replaceIDs f maps r)+    replaceIDs f maps (NExpCond off ct c r) =+      NExpCond off ct (replaceIDs f maps c) (replaceIDs f maps r)+    replaceIDs f maps (NExpFieldExp off n ps) =+      NExpFieldExp off+                   (replaceIDs f maps n)+                   (map (\(x,y) -> (x, replaceIDs f maps y)) ps)+    replaceIDs f maps (NExpProjection off r) =+      NExpProjection off (replaceIDs f maps r)+    replaceIDs f maps (NExpForward off r) =+      NExpForward off (replaceIDs f maps r)+    replaceIDs f maps (NExpHidden off cs r) =+      NExpHidden off (map (replaceIDs f maps) cs) (replaceIDs f maps r)+    replaceIDs f maps (NExpExpanded off ms) =+      NExpExpanded off (map (replaceIDs f maps) ms)+    replaceIDs _ _ x = x+expandFunction _ x = x-}++applications :: NodeExp -> NodeExp -> [NodeExp]+applications x y =+  if isSimpleNodeType x+    then []+    else apps (getNode x) y+  where+    apps :: FileNode -> NodeExp -> [NodeExp]+    apps f y =+      if isSimpleNodeType y+        then []+        else+          case y of+            NExpApp n fun _ _ -> if f == getNode fun+                                   then y:(concatMap (apps f) (branches y))+                                   else concatMap (apps f) (branches y)+            _                 -> concatMap (apps f) (branches y)++-- removes cycles in the function and argument pointers+removeNonResultCycles :: NodeExp -> NodeExp+removeNonResultCycles = remCycles []+  where+    remCycles :: [FileNode] -> NodeExp -> NodeExp+    remCycles visited (NExpApp node fun args res)+      = if node `elem` visited+          then NExpNonResultCycle node+          else NExpApp node+                       (remCycles (node:visited) fun)+                       (map (remCycles (node:visited)) args)+                       res+    remCycles visited (NExpCond node condType cond res)+      = if node `elem` visited+          then NExpNonResultCycle node+          else NExpCond node+                        condType+                        (remCycles (node:visited) cond)+                        (remCycles (node:visited) res)+    remCycles visited (NExpFieldExp node exp mappings)+      = if node `elem` visited+          then NExpNonResultCycle node+          else NExpFieldExp node+                            (remCycles (node:visited) exp)+                            (map remCycs mappings)+        where+          remCycs :: (String, NodeExp) -> (String, NodeExp)+          remCycs (x,y) = (x, remCycles (node:visited) y)+    remCycles _ y = y++children :: NodeExp -> [NodeExp]+children exp@(NExpConstUse _ _ r) = children r+children exp@(NExpHidden _ _ _) =+  chldrn (getNode exp) (branches exp)+children exp =+  (case result exp of+    NExpProjection n r -> chldrn (getNode pexp) (branches pexp)+                          where+                            pexp =   removeResultCycles+                                   $ removeNonResultCycles+                                   $ nodeExpForNode+                                   $ redexParent n+    _                  -> chldrn (getNode exp) (branches exp))++chldrn :: FileNode -> [NodeExp] -> [NodeExp]+chldrn n exps =+  (newApps ++ if null newApps+               then []+               else chldrn n (concatMap branches newApps))+  where+    newApps :: [NodeExp]+    newApps = concatMap (findAppsMatching ((==n) . redexParent . getNode))+                        exps++findAppsMatching :: (NodeExp -> Bool) -> NodeExp -> [NodeExp]+findAppsMatching f exp@(NExpApp _ fu as r) =+  if f exp then case r of+                  NExpResultCycle _+                    -> concatMap (findAppsMatching f) $ (fu:as)+                  NExpNonResultCycle _+                    -> concatMap (findAppsMatching f) $ (fu:as)+                  _ -> [exp]+           else []+findAppsMatching f exp@(NExpConstUse _ _ r) =+  if f exp then+    if isTotallyHidden r+      then []+      else case r of+             NExpResultCycle _    -> []+             NExpNonResultCycle _ -> []+             _                    -> [exp]+  else []+findAppsMatching f exp@(NExpConstDef _ _ _) =+  if f exp then concatMap (findAppsMatching f) (branches exp)+           else []+findAppsMatching f exp@(NExpCond _ _ _ _) =+  if f exp then concatMap (findAppsMatching f) (branches exp)+           else []+findAppsMatching f exp@(NExpProjection _ _) =+  if f exp then concatMap (findAppsMatching f) (branches exp)+           else []+findAppsMatching f exp@(NExpIdentifier _ _ _) =+  if f exp then [exp]+           else []+findAppsMatching f exp@(NExpConstructor _ _ _) =+  if f exp then [exp]+           else []+findAppsMatching f exp@(NExpHidden n c r) =+  [exp]+findAppsMatching f exp@(NExpResultCycle _) = []+findAppsMatching f exp@(NExpNonResultCycle _) = []+findAppsMatching f exp =+  concatMap (findAppsMatching f) $ branches exp++nodeExp2SExp :: NodeExp -> SExp String+nodeExp2SExp app@(NExpApp _ fun args _)+  = if isAppString app+      then SString "" (buildString app) False+      else SApp "" ((nodeExp2SExp fun):(map nodeExp2SExp args))+nodeExp2SExp (NExpConstUse _ id _)+  = SId "" id SInfixDefault+nodeExp2SExp (NExpConstDef _ id _)+  = SId "" id SInfixDefault+nodeExp2SExp (NExpIdentifier _ id fix)+  = SId "" id fix+nodeExp2SExp (NExpConstructor _ id fix)+  = SId "" id fix+nodeExp2SExp (NExpLiteral _ lit)+  = SLiteral "" lit+nodeExp2SExp (NExpCond _ IfCond cond res)+  = SIf "" (nodeExp2SExp cond) (Just (nodeExp2SExp res))+nodeExp2SExp (NExpCond _ CaseCond cond res)+  = SCase "" (nodeExp2SExp cond) (Just (nodeExp2SExp res))+nodeExp2SExp (NExpCond _ GuardCond cond res)+  = SGuard "" (nodeExp2SExp cond) (Just (nodeExp2SExp res))+nodeExp2SExp (NExpFieldExp _ exp mappings)+  = SFieldExpr ""+               (nodeExp2SExp exp)+               (fst namesAndResults)+               (map nodeExp2SExp (snd namesAndResults))+    where namesAndResults = unzip mappings+nodeExp2SExp (NExpProjection _ res)+  = nodeExp2SExp res+nodeExp2SExp (NExpForward _ res)+  = nodeExp2SExp res+nodeExp2SExp (NExpHidden _ _ res)+  = nodeExp2SExp res+nodeExp2SExp NExpInterrupt = SInterrupted ""+nodeExp2SExp NExpBottom = SBottom ""+nodeExp2SExp NExpUneval = SUnevaluated ""+nodeExp2SExp NExpNotShown = SCut ""+nodeExp2SExp (NExpResultCycle _) = SInfinite ""+nodeExp2SExp (NExpExpanded n apps) = --SString "" (show n) False --+  SFiniteMap "" (makeMaps apps)++makeMaps :: [NodeExp] -> [([SExp String],SExp String)]+makeMaps =+  map makeMap+  where+    makeMap :: NodeExp -> ([SExp String],SExp String)+    makeMap (NExpApp _ _ as r) =+      (map (nodeExp2SExp . fullEval) as, nodeExp2SExp $ fullEval r)++isAppString :: NodeExp -> Bool+isAppString (NExpApp _ (NExpApp _ fun@(NExpConstructor _ name _) args1 _) args2 _)+  = if name == (Qualified "Prelude" ":") then+      if argNode /= LowLevel.nil &&+         argNode /= LowLevel.unevaluated &&+         argNode /= LowLevel.entered &&+         argNode /= LowLevel.interrupted then+        ((nodeType argNode) == ExpChar)+         && (not $ null $ tail args)+         && ((isAppString (mHead "isAppString 1.2" (tail args)))+             || isEmptyList (mHead "isAppString 1.3" (tail args)))+      else False+    else False+    where+      args = args1 ++ args2+      argNode = (getNode (mHead "isAppString 1.1" args))+isAppString (NExpApp _ fun@(NExpConstructor _ name _) args _)+  = if name == (Qualified "Prelude" ":") then+      if argNode /= LowLevel.nil &&+         argNode /= LowLevel.unevaluated &&+         argNode /= LowLevel.entered &&+         argNode /= LowLevel.interrupted then+        ((nodeType argNode) == ExpChar)+         && (not $ null $ tail args)+         && ((isAppString (mHead "isAppString 2.2" (tail args)))+             || isEmptyList (mHead "isAppString 2.3" (tail args)))+      else False+    else False+    where+      argNode = (getNode (mHead "isAppString 2.1" args))+isAppString exp = False++buildString :: NodeExp -> String+buildString (NExpApp _ _ (l@(NExpLiteral _ _):r) _)+  = (:) (getCharFromLit l)+        (if (isEmptyList (mHead "buildString 2" r))+          then []+          else buildString (mHead "buildString 3" r))+buildString (NExpApp _ (NExpApp _ _ (l@(NExpLiteral _ _):r1) _) r2 _)+  = (:) (getCharFromLit l)+        (if (isEmptyList (mHead "buildString 2" (r1 ++ r2)))+          then []+          else buildString (mHead "buildString 3" (r1 ++ r2)))+++isEmptyList :: NodeExp -> Bool+isEmptyList (NExpConstructor _ (Qualified "Prelude" "[]") _) = True+isEmptyList exp = False++getCharFromLit :: NodeExp -> Char+getCharFromLit (NExpLiteral node charList)+  = (mHead "getCharFromLit 2" (tail charList))++mHead r l = seq (if null l then unsafePerformIO $ putStrLn r else ())+                head l
+ tools/NonTermLib.hs view
@@ -0,0 +1,533 @@+module NonTermLib+  ( +  -- FileNode Functions+    FileNode(..)+  , getNodeChildren+  , getRootNode+  , peekResultMod+  , getResultHT+  , nextFileNode+  , showNodeType++  -- function node functions+  , getFuncPtr+  , getFuncName+  , getFuncModule++  -- State+  , State(..)+  , emptyState+  , setOptions++  -- SExp Functions+  , SExp(..)+  , getSExpNode +  , fileNode2SExpMod++  -- Sctx+  , Sctx+  , showSctx++  -- Monad functions+  , initialiseCount+  , incrementCount+  , getCount+  , printAndFalse+  , printList+  , mapIO++  -- auxilliary functions+  , inter+  , member+  , remove+  , breakAfter++  ) where+ ++import SExp        hiding (transFixity)+import SrcRef             (SrcRef(..),readSrcRef)+import LowLevel+import Foreign.C.String   (CString(..), peekCString)+import System.IO.Unsafe   (unsafePerformIO)+import Data.List          (isPrefixOf)+import Data.Char          (ord)+import System.IO          (hPutStrLn,stderr)+import Numeric            (showHex)+import System.Exit        (exitWith,ExitCode(..))+import PrettyLibHighlight (Doc,groupNest,highlight,pretty,nest,text,(<>))+import qualified PrettyLibHighlight as Pretty (highlight)+import HighlightStyle     (goto,cls,clearDown,clearUp,cleareol,highlightOff+                          ,Highlight(..),Colour(..)+                          ,enableScrollRegion,savePosition,restorePosition)+++-- FileNode functions++-- make filenodes printable, and orderable+-- instance Show FileNode where+--  show fn = showHex (int fn) ""++-- instance Ord FileNode where+--   (FileNode x) <= (FileNode y) = x <= y+--   (FileNode x) >= (FileNode y) = x >= y+--   (FileNode x) < (FileNode y)  = x < y+--   (FileNode x) > (FileNode y)  = x > y+++getNodeChildren :: FileNode -> [FileNode]+getNodeChildren n = remove n (map (getImmediateExpArg n) [0..arity])+  where arity = getExpArity n++foreign import ccall "nontermutils.h"+	getImmediateExpArg :: FileNode -> Int -> FileNode+foreign import ccall "nontermutils.h"+	getExpArity   :: FileNode -> Int+foreign import ccall "nontermutils.h"+	getRootNode :: FileNode+foreign import ccall "nontermutils.h"+	peekResultMod :: FileNode -> FileNode+foreign import ccall "nontermutils.h"+	getResultHT :: FileNode -> Bool -> FileNode+foreign import ccall "nontermutils.h"+	nextFileNode :: FileNode -> FileNode+++-- Show the type of a node+showNodeType node | node <= (FileNode 4)	= "special"+                | ntype == ExpApp		= "ExpApp"+                | ntype == ExpValueApp		= "ExpValueApp"+                | ntype == ExpValueUse		= "ExpValueUse"+                | ntype == ExpConstUse		= "ExpConstUse"+                | ntype == ExpConstDef		= "ExpConstDef"+                | ntype == ExpGuard		= "ExpGuard"+                | ntype == ExpCase		= "ExpCase"+                | ntype == ExpIf		= "ExpIf"+                | ntype == ExpForward		= "ExpForward"+                | ntype == ExpProjection	= "ExpProjection"+                | ntype == Module		= "Module"+                | ntype == SrcPos		= "SrcPos"+                | ntype == ExpChar		= "ExpChar"+                | ntype == ExpInt 		= "ExpInt"+                | ntype == ExpInteger		= "ExpInteger"+                | ntype == ExpRat		= "ExpRat"+                | ntype == ExpRational		= "ExpRational"+                | ntype == ExpFloat		= "ExpFloat"+                | ntype == ExpDouble		= "ExpDouble"+                | ntype == ExpFieldUpdate	= "ExpFieldUpdate"+                | ntype == ExpHidden		= "ExpHidden"+                | ntype == ExpDoStmt		= "ExpDoStmt"+                | ntype == AtomVariable		= "AtomVariable"+                | ntype == AtomConstructor	= "AtomConstructor"+                | ntype == AtomAbstract		= "AtomAbstract"+  where ntype = nodeType node+++-- get a pointer to a the function definition for an expression+foreign import ccall "nontermutils.h" getFuncPtr :: FileNode -> FileNode++-- get the name of a function from a NodeApplication+getFuncName :: FileNode -> String+foreign import ccall "nontermutils.h" getFuncNm :: FileNode -> CString +getFuncName n = unsafePerformIO (peekCString (getFuncNm n))++-- get the module of a function from a NodeApplication+getFuncModule :: FileNode -> String+foreign import ccall "nontermutils.h" getFuncMod :: FileNode -> CString +getFuncModule n = unsafePerformIO (peekCString (getFuncMod n))+++-- SExp Stuff++{- requires overlapping instances:+-- test SExps for equality+instance Eq (SExp Label) where+  x == y = (getSExpNode x) == (getSExpNode y)+-}++-- get the filenode from an SExp+getSExpNode sexp = snd (label sexp)+++-- The state datatype holds all of the configuration data for the tools+data State = State+	{ progname  :: String           -- program name+	, file      :: FilePath		-- .hat filename+	, width     :: Int		-- terminal screen size+	, height    :: Int		-- terminal screen size+	, strSugar  :: Bool		-- show strings with sugar?+	, listSugar :: Bool		-- show lists with sugar?+	, srcrefs   :: Bool		-- always show src references?+	, showQual  :: Bool		-- show identifiers qualified?+	, cutoff    :: Int		-- expression cutoff depth+	, numFn     :: Int              -- how many instances of fn+	, showRoot  :: Bool             -- cut off the head of the trail?+	, showNode  :: Bool             -- show the trail nodes?+	, showSrcRef:: Bool		-- show source ref?+	, showCount :: Bool		-- show number of nodes visited+	}++-- the emptyState function gives a state with all the defaults set+emptyState :: State+emptyState = State { strSugar=True, listSugar=True, srcrefs=True+                    ,showQual=False, cutoff=10, numFn=3, showRoot=False+		    ,showNode=False,showSrcRef=False,showCount=False}++-- set state options from a list of command-line arguments+setOptions :: [String] -> State+setOptions (_:args) = setOpt args+  where+    setOpt [] = emptyState+    setOpt (x:xs) | "--showqual" `isPrefixOf` x = state {showQual = bool}+                  | "--cutoff" `isPrefixOf` x   = state {cutoff = num}+                  | "--numfn" `isPrefixOf` x    = state {numFn = num}+		  | "--showrt" `isPrefixOf` x   = state {showRoot = bool}+		  | "--shownode" `isPrefixOf` x = state {showNode = bool}+		  | "--srcref" `isPrefixOf` x   = state {showSrcRef = bool}+		  | "--showcount" `isPrefixOf` x = state {showCount = bool}+                  | otherwise                   = setOpt xs+      where bool = if (val /= [] && ((head val) == 'f' || (head val) == 'F')) +		    then False else True+            num = decimalStringToInt val+            val = breakAfter ('='==) x+            state = setOpt xs+++-- The stack context There is actually already an Sctx used by (iirc)+-- hat-trail. This is because I originally used that type. I should+-- change the name really.  Anyway, this type is used so that all of the+-- filenodes corresponding to an expression are bunched together in the+-- search process+type Sctx = [FileNode]++-- convert a stack context to a string with highlighting This is really+-- the central display function. Most of these functions are reused+-- from Hat.+showSctx :: State -> Sctx -> String+showSctx state ctx@(node:_) | (showSrcRef state) = str ++ srcref+                            | otherwise          = str+  where+    -- these four expressions turn the Sctx into a string with highlighting+    root = fileNode2SExpMod (cutoff state) True +                            (strSugar state) True ("",node) +    doc = sExp2Doc False (listSugar state) (showQual state) nodehigh root+    prompt = Pretty.highlight [Foreground Blue] (text "> ")+    str = pretty (width state) (prompt <> doc)++    nodehigh = high (last ctx)++    -- create a source reference string+    srcref | line == 0 && col == 0 = " " ++ (showNodeType (snd (label root))) ++ " (no ref)"+           | otherwise             = " (L" ++ (show col) +	                              ++ ",C" ++ (show line) ++ ")"+      where sr   = readSrcRef (expSrcRef root)+            line = SrcRef.line sr+            col  = SrcRef.column sr++    -- highlight an SExp node, depending on its filenode value+    high :: FileNode -> Label -> Doc -> Doc+    high node v +      | (snd v) == node = Pretty.highlight [Bold,Foreground Red]+      | otherwise       = id++-- get a source reference node from another filenode+expSrcRef :: SExp Label -> FileNode+expSrcRef (SEquation _ lhs rhs) = expSrcRef lhs+expSrcRef exp = getSrcRef node+  where node = (snd (label exp))+++-- Monad functions++-- initialise the counter which counts the number of node accesses +foreign import ccall "nontermutils.h" initialiseCount :: IO ()+foreign import ccall "nontermutils.h" getCount :: Int++-- increment the node access count by the argument value+foreign import ccall "nontermutils.h" incCount :: Int -> IO ()+incrementCount :: Int -> Bool+incrementCount x = unsafePerformIO (do incCount x+                                       return True)++-- DEBUGGING+-- print the value, and return false. Can be used at the start of conditional +-- expressions to print out important values.+-- And yes, I know that's basically what Hood does.+printAndFalse :: Show x => x -> Bool+printAndFalse x = unsafePerformIO printFunc+  where printFunc = do print x+                       return False++-- print all the items of a list+printList :: Show x => [x] -> IO ()+printList xs = mapIO print xs++-- map a monadic function over a list+-- I'm pretty sure something like this must already exist+mapIO :: (a -> IO ()) -> [a] -> IO ()+mapIO funcIO [] = return ()+mapIO funcIO (x:xs) = do funcIO x+                         mapIO funcIO xs+++-- Auxilliary functions++-- interpolate two lists+inter xs [] = []+inter [] ys = []+inter (x:xs) (y:ys) = (x:y:(inter xs ys))++-- test membership+member x [] = False+member x (y:ys) = x == y || member x ys++-- remove something from a list+remove x [] = []+remove x (y:ys) | x == y    = ys+                | otherwise = (y : (remove x ys))+++-- This function is a modified version of the function used in Hat.  The+-- modifications are basically limited to commenting out two lines,+-- so that fileNode2SExpMod doesn't replace expressions which have an+-- interrupted / bottom result with a placeholder+fileNode2SExpMod :: Int -> Bool -> Bool -> Bool -> Label -> SExp Label+fileNode2SExpMod cutoff uneval strings toplevelLHS label =+  case go cutoff uneval strings toplevelLHS [] label of (e,_,_) -> e  +  where+  simple e = (e,[],[])+  go :: Int			-- cutoff depth+       -> Bool			-- show unevaluated args in full?+       -> Bool			-- sugar character strings?+       -> Bool			-- top-level LHS? (implies uneval to one level)+       -> [(FileNode,String)]	-- enclosing nodes w/ variable name for `where'+       -> Label 		-- root node of expression+       -> ( SExp Label		-- expression +          , [FileNode]		-- nodes that start cycle+          , [String] )		-- variable names occurring (except for cycles)+  go 0     uneval strings top nodesAbove label = simple (SCut label)+  go depth uneval strings top nodesAbove label@(lab,node) =+    if      node == LowLevel.nil then simple $ SUnevaluated label+    else if node == unevaluated then simple $ SUnevaluated label+    else if node == entered then simple $ SBottom label+    else if node == interrupted then simple $ SInterrupted label+    else if node == lambda then simple $ SLambda label+    else if node == dolambda then simple $ SDoLambda label+    else+    let r = peekResult node in+    if  r == unevaluated && not (uneval||top) then simple $ SUnevaluated label+    -- these lines were commented out for black-hat / hat-nonterm+    --else if r == entered && not top then simple $ SBottom label+    --else if r == interrupted && top then simple $ SInterrupted label+    else if r == lambda && not uneval then simple $ SLambda label+    else if r == dolambda && not uneval then simple $ SDoLambda label+    else +    case simpleNodeType node of+      NodeModule -> "got a Module" `errorAt` node+      NodeSrcPos -> "got an SrcPos" `errorAt` node+      NodeAtom -> -- "got an Atom" `errorAt` node+        let i = getAtom node+            m = getAtomMod node+        in simple (SId label (Qualified m i) (transFixity (getAtomFixity node)))+      NodeApplication -> +        let partCycles :: [FileNode]+            partCycles = (funCycles ++ concat argsCycles)+            partVars :: [String]+            partVars = funVars ++ concat argsVars+            isCycle = node `elem` partCycles+            var :: String+            var = head . filter (not . (`elem` partVars)) .+                  map (("cyc"++) . show) $ [1..] +            newNodesAbove :: [(FileNode,String)]+            newNodesAbove = (node,var) : nodesAbove+            subExps :: [FileNode]+            subExps = getNodeChildren node+            -- (fun,funCycles,funVars) = ... not accepted by nhc98+            fun = fst3 z+            funCycles = snd3 z+            funVars = thd3 z+            z = let f = head subExps in+                if f==LowLevel.nil then simple (SCut ('f':lab,f))+                else go depth uneval strings False newNodesAbove ('f':lab,f)+            args = fst3 zs+            argsCycles = snd3 zs+            argsVars = thd3 zs+            -- (args,argsCycles,argsVars) = ... not accepted by nhc98+            zs = unzip3 $ map (go (depth-1) uneval strings False newNodesAbove)+                              (zipWith lbl ['1'..] (tail subExps))+            lbl c n = (c:lab, n)+            -- To do strings right, need to peek one level inside a cons.+            z1 = go 1 uneval strings False newNodesAbove+                 ('1':lab, subExps!!1)	-- only used in string cutoff case+            z2 = go 3 uneval strings False newNodesAbove+                 ('2':lab, subExps!!2)	-- only used in string cutoff case++            sexp = case fun of+              -- convert the representation of constructors with fields+              SId n@(_,m) c _ | isConstrFields m ->+                SFieldExpr label (SId n c SInfixDefault)+                                 (getFieldLabels m) args+              -- convert char-list into string+              SId _ (Qualified _ ":") _ | strings && length args == 2 ->+                case args!!0 of+                  SLiteral _ c | not (null c) && head c == '\'' ->+                    case args!!1 of+                      SId _ (Qualified _ "[]") _+                                    -> SString label (init (tail c)) False+                      SString _ s d -> SString label (init (tail c)++s) d+                      _             -> SApp label (fun:args)+                  SCut _ ->	-- peek beyond the cut+                    case fst3 z1 of+                      SLiteral _ c | not (null c) && head c == '\'' ->+                        case fst3 z2 of+                          SId _ (Qualified _ "[]") _+                             -> SString label (init (tail c)) False+                          _  -> SString label (init (tail c)) True+                      _ -> SApp label (fun:args)+                  _ -> SApp label (fun:args)+              -- different bracketing of a char-list+              SApp _ args1@[SId _ (Qualified _ ":") _,SLiteral _ c]+                | strings && length args == 1+                && not (null c) && head c == '\'' ->+                    case args!!0 of+                      SId _ (Qualified _ "[]") _+                                    -> SString label (init (tail c)) False+                      SString _ s d -> SString label (init (tail c)++s) d+                      _             -> SApp label (args1++args)+              SApp _ args1@[SId _ (Qualified _ ":") _,SCut _]+                | strings && length args == 1 ->+                    fst3 (go (depth+1) uneval strings False nodesAbove label)+              -- combine applications+              SApp n args1 -> SApp label (args1++args)+              -- anything else is just a simple application+              _ -> SApp label (fun:args)+        in case lookup node nodesAbove of+             Just var -> (SId label (Plain var) SInfixDefault,[node],[]) +                         -- `lower' end of cycle+             Nothing -> ( if isCycle then SCycle (lab,node) var sexp else sexp+                        , partCycles, partVars)+      NodeBasicValue ->+          let i = getValue node in simple $ SLiteral label i+      NodeIdentifier ->+          if isLambda node then simple (SLambda label) else+          let i = getValue node+              m = getValueMod node+          in+          ( SId label (Qualified m i) (case i of+                           "."  | m == "Prelude" -> SAssoc 9 i+                           "++" | m == "Prelude" -> SAssoc 5 i+                           "&&" | m == "Prelude" -> SAssoc 3 i+                           "||" | m == "Prelude" -> SAssoc 2 i+                           "*"  | m == "Prelude" -> SAssoc 7 i+                           "+"  | m == "Prelude" -> SAssoc 6 i+                           ">>" | m == "Prelude" -> SAssoc 1 i+                           ">>=" | m == "Prelude" -> SAssoc 1 i+                           _ -> transFixity (getFixity node))+          , []+          , if isConstructor node then [] else [i] )+      NodeCAF ->+          let i = getValue node+              m = getValueMod node+          in simple (SId label (Qualified m i) (transFixity (getFixity node)))+      NodeConditional ->+          let skind = case nodeType node of+                          ExpGuard -> SGuard+                          ExpCase  -> SCase+                          ExpIf    -> SIf+              within :: Label -> (SExp Label->Maybe (SExp Label)->SExp Label)+                        -> SExp Label -> SExp Label -> SExp Label+              within labl kind parent exp =+                case parent of+                    SWithin _ ps -> SWithin labl (ps++[kind exp Nothing])+                    _            -> SWithin labl [parent,kind exp Nothing]+          in simple $+             within label (skind ('c':lab,node))+                          (fileNode2SExpMod depth uneval strings True+                                         ('w':lab, getParentNode node))+                          (fileNode2SExpMod depth uneval strings False+                                         ('v':lab, head (getSubExprs node)))+      NodeSugar -> -- simple $ SLiteral label "{sugar}"+          case nodeType node of+            ExpDoStmt -> simple $ SLiteral label "{do stmt}"+            ExpFieldUpdate ->+                let (exp:updValues) = getSubExprs node+                    updLabels = getFieldLabels node+                in simple $+                   SFieldExpr label+                              (fileNode2SExpMod (depth-1) uneval strings False+                                             ('u':lab, exp))+                              updLabels+                              (map (fileNode2SExpMod (depth-1) uneval+                                                  strings False)+                                   (zipWith (\i v-> (i:lab, v))+                                            ['1'..] updValues))+      NodeSpecial ->+          case nodeType node of+            ExpProjection ->+                (\(exp,x,y) -> (relabel ('p':lab,node) exp, x, y) ) $+                go depth uneval strings False nodesAbove+                   ('p':lab, getResult (head (getSubExprs node)) top)+            ExpHidden -> simple $ SLiteral label "{?}"+            ExpForward ->+                go depth uneval strings False nodesAbove+                   (lab, head (getSubExprs node))++  errorAt :: String -> FileNode -> a+  errorAt str node = errorT ("SExp: "++str++" at 0x"++showHex (int node) "")+++-- translate fixity from the file representation to the structured+-- Sfixity type. This is another steal from Hat. It is needed to make +-- fileNode2SExpMod work.+transFixity :: Int -> SFixity+transFixity f = case f `divMod` 4 of+                  (p,0) -> SInfix p+                  (p,1) -> SInfixR p+                  (p,2) -> SInfixL p+                  (p,3) -> SInfixDefault++-- see above re. fileNode2SExpMod+fst3 (x,_,_) = x+snd3 (_,x,_) = x+thd3 (_,_,x) = x++-- see above re. fileNode2SExpMod+relabel :: a -> SExp a -> SExp a+relabel l (SApp _ es)     = SApp l es+relabel l (SId _ v f)     = SId l v f+relabel l (SLiteral _ s)  = SLiteral l s+relabel l (SString _ s d) = SString l s d+relabel l (SLambda _)     = SLambda l+relabel l (SWithin _ e)   = SWithin l e+relabel l (SIf _ e r)     = SIf l e r+relabel l (SCase _ e r)   = SCase l e r+relabel l (SGuard _ e r)  = SGuard l e r+relabel l (SCut _)        = SCut l+relabel l (SUnevaluated _)= SUnevaluated l+relabel l (SInterrupted _)= SInterrupted l+relabel l (SBottom _)     = SBottom l+relabel l (SCycle _ a b)  = SCycle l a b+relabel l (SEquation _ e r) = SEquation l e r+relabel l (SFieldExpr _ e labs upds) = SFieldExpr l e labs upds++-- see above re. fileNode2SExpMod+errorT  :: String -> a+errorT s = unsafePerformIO (do hPutStrLn stderr s; return (error ""))+debugT  :: (Show a) => String -> a -> a+debugT s x = unsafePerformIO (do hPutStrLn stderr (s++show x); return x)+++-- Turn a string of decimal characters into an integer value +decimalStringToInt digits = decimalStringToInt' digits 0+decimalStringToInt' [] acc = acc+decimalStringToInt' (d:digits) acc +  | d >= '0' && d <= '9' +                = decimalStringToInt' digits ((10 * acc) + (ord d - ord '0'))+  | otherwise	= -1+++-- cut everything up to and including whatever matches condition f+breakAfter f [] = []+breakAfter f (x:xs) | (f x)     = xs+                    | otherwise = breakAfter f xs+
+ tools/Observe.hs view
@@ -0,0 +1,92 @@+module Observe+  ( ObserveResult(..)+  ,   isFound+  ,   isNotFound+  ,   isInterrupted+  ,   fromFound+  , newObservation	-- :: QName -> Maybe QName -> Bool -> Int+			--      -> ObserveResult+  , newObservationSrc	-- :: String -> Int -> Int -> ObserveResult+-- , observableInfo	-- :: Int -> IO ()+  ) where++import LowLevel+import Foreign.Ptr      (Ptr)+import Foreign.C.String (CString, withCString)+import System.IO.Unsafe (unsafePerformIO)+import SExp (QName(..))++------------------------------------------------------------------------+data ObserveResult = Found [FileNode]+                   | NotFound+                   | Interrupted++isInterrupted :: ObserveResult -> Bool+isInterrupted Interrupted = True+isInterrupted _           = False++isNotFound :: ObserveResult -> Bool+isNotFound NotFound       = True+isNotFound _              = False++isFound :: ObserveResult -> Bool+isFound (Found _)         = True+isFound _                 = False++fromFound :: ObserveResult -> [FileNode]+fromFound (Found r)         = r+fromFound _                 = []++------------------------------------------------------------------------+foreign import ccall "observeutils.h"+    setObserveContext :: Bool -> Bool -> Int -> CString -> IO ()+foreign import ccall "observeutils.h"+    lookForFirstApp   :: CString -> IO FileNode+foreign import ccall "observeutils.h"+    lookForFirstSrc   :: Int -> Int -> CString -> IO FileNode+foreign import ccall "observeutils.h"+    nextObservation   :: FileNode -> IO FileNode+--foreign import ccall observableInfo    :: Int -> IO ()++-- Get all observations for ident1 (within ident2 if available)+-- If ident2 is Nothing, then the `recursive' flag selects whether+-- calls from ident1 to itself are included.+newObservation :: QName -> Maybe QName -> Bool -> Int -> ObserveResult+newObservation ident1 ident2 rec arity =+  unsafePerformIO $+  do _ <- case ident2 of+            Nothing -> withCString "" (setObserveContext False rec arity)+            Just id -> withCString (noQ id) (setObserveContext True True arity)+     n <- withCString (noQ ident1) lookForFirstApp+     case int n of+       1 -> return NotFound+       3 -> return Interrupted+       _ -> return (Found (n: moreObservations n))+  where+    noQ qn = case qn of Plain v -> v; Qualified _ v -> v++moreObservations :: FileNode -> [FileNode]+moreObservations n =+  unsafePerformIO $+  do n' <- nextObservation n+     case int n' of+       1 -> return []+       3 -> return []+       _ -> return (n': moreObservations n')++-- Get all observations at the given source location.+newObservationSrc :: String -> Int -> Int -> ObserveResult+newObservationSrc moduleName line column =+  unsafePerformIO $+  do withCString "" (setObserveContext False True 0)+     n <- withCString moduleName (lookForFirstSrc line column)+     case int n of+       1 -> return NotFound+       3 -> return Interrupted+       _ -> return (Found (n: moreObservations n))++------------------------------------------------------------------------+{-+foreign import ccall observeGlobalsNum   :: IO Int+foreign import ccall observeGlobalsArray :: IO (Ptr (Ptr Info))+-}
+ tools/ParseLib.hs view
@@ -0,0 +1,203 @@+{-----------------------------------------------------------------------------+* extension: parameterised on token type+*   by Malcolm Wallace++                 A LIBRARY OF MONADIC PARSER COMBINATORS++                              29th July 1996++                 Graham Hutton               Erik Meijer+            University of Nottingham    University of Utrecht++This Haskell 1.3 script defines a library of parser combinators, and is taken+from sections 1-6 of our article "Monadic Parser Combinators".  Some changes+to the library have been made in the move from Gofer to Haskell:++   * Do notation is used in place of monad comprehension notation;++   * The parser datatype is defined using "newtype", to avoid the overhead+     of tagging and untagging parsers with the P constructor.++-----------------------------------------------------------------------------}++module ParseLib+   (Parser(..), item, first, papply, (+++), sat, tok, many, many1,+    sepby, sepby1, chainl, chainl1, chainr, chainr1, ops, bracket,+ -- char, digit, lower, upper,+ -- letter, alphanum, string, ident, nat, int, spaces, comment, junk,+ -- skip, token, natural, integer, symbol, identifier+   ) where++import Data.Char+import Control.Monad++infixr 5 +++++--- The parser monad ---------------------------------------------------------++newtype Parser t a = P ([t] -> [(a,[t])])++instance Functor (Parser t) where+   -- map         :: (a -> b) -> (Parser t a -> Parser t b)+   fmap f (P p)    = P (\inp -> [(f v, out) | (v,out) <- p inp])++instance Monad (Parser t) where+   -- return      :: a -> Parser t a+   return v        = P (\inp -> [(v,inp)])+   -- >>=         :: Parser t a -> (a -> Parser t b) -> Parser t b+   (P p) >>= f     = P (\inp -> concat [papply (f v) out | (v,out) <- p inp])+   -- fail        :: String -> Parser t a+   fail _          = P (\inp -> [])++instance MonadPlus (Parser t) where+   -- mzero       :: Parser t a+   mzero           = P (\inp -> [])+   -- mplus       :: Parser t a -> Parser t a -> Parser t a+   (P p) `mplus` (P q)  = P (\inp -> (p inp ++ q inp))++--- Other primitive parser combinators ---------------------------------------++item               :: Parser t t+item                = P (\inp -> case inp of+                                   []     -> []+                                   (x:xs) -> [(x,xs)])++force             :: Parser t a -> Parser t a+force (P p)        = P (\inp -> let x = p inp in+                                (fst (head x), snd (head x)) : tail x)++first             :: Parser t a -> Parser t a+first (P p)        = P (\inp -> case p inp of+                                   []     -> []+                                   (x:xs) -> [x])++papply            :: Parser t a -> [t] -> [(a,[t])]+papply (P p) inp   = p inp++--- Derived combinators ------------------------------------------------------++(+++)             :: Parser t a -> Parser t a -> Parser t a+p +++ q            = first (p `mplus` q)++sat               :: (t -> Bool) -> Parser t t+sat p              = do {x <- item; if p x then return x else mzero}++tok               :: Eq t => t -> Parser t t+tok t              = do {x <- item; if t==x then return t else mzero}++many              :: Parser t a -> Parser t [a]+many p             = many1 p +++ return []+--many p           = force (many1 p +++ return [])++many1             :: Parser t a -> Parser t [a]+many1 p            = do {x <- p; xs <- many p; return (x:xs)}++sepby             :: Parser t a -> Parser t b -> Parser t [a]+p `sepby` sep      = (p `sepby1` sep) +++ return []++sepby1            :: Parser t a -> Parser t b -> Parser t [a]+p `sepby1` sep     = do {x <- p; xs <- many (do {sep; p}); return (x:xs)}++chainl            :: Parser t a -> Parser t (a -> a -> a) -> a -> Parser t a+chainl p op v      = (p `chainl1` op) +++ return v++chainl1           :: Parser t a -> Parser t (a -> a -> a) -> Parser t a+p `chainl1` op     = do {x <- p; rest x}+                     where+                        rest x = do {f <- op; y <- p; rest (f x y)}+                                 +++ return x++chainr            :: Parser t a -> Parser t (a -> a -> a) -> a -> Parser t a+chainr p op v      = (p `chainr1` op) +++ return v++chainr1           :: Parser t a -> Parser t (a -> a -> a) -> Parser t a+p `chainr1` op     = do {x <- p; rest x}+                     where+                        rest x = do { f <- op+                                    ; y <- p `chainr1` op+                                    ; return (f x y)}+                                 +++ return x++ops               :: [(Parser t a, b)] -> Parser t b+ops xs             = foldr1 (+++) [do {p; return op} | (p,op) <- xs]++bracket           :: Parser t a -> Parser t b -> Parser t c -> Parser t b+bracket open p close = do {open; x <- p; close; return x}++{-+--- Useful parsers -----------------------------------------------------------+char              :: Char -> Parser Char+char x             = sat (\y -> x == y)++digit             :: Parser Char+digit              = sat isDigit++lower             :: Parser Char+lower              = sat isLower++upper             :: Parser Char+upper              = sat isUpper++letter            :: Parser Char+letter             = sat isAlpha++alphanum          :: Parser Char+alphanum           = sat isAlphanum +++ char '_'++string            :: String -> Parser String+string ""          = return ""+string (x:xs)      = do {char x; string xs; return (x:xs)}++ident             :: Parser String+ident              = do {x <- lower; xs <- many alphanum; return (x:xs)}++nat               :: Parser Int+nat                = do {x <- digit; return (fromEnum x - fromEnum '0')} `chainl1` return op+                     where+                        m `op` n = 10*m + n++int               :: Parser Int+int                = do {char '-'; n <- nat; return (-n)} +++ nat++--- Lexical combinators ------------------------------------------------------++spaces            :: Parser ()+spaces             = do {many1 (sat isSpace); return ()}++comment           :: Parser ()+--comment            = do {string "--"; many (sat (\x -> x /= '\n')); return ()}+--comment            = do +--                       _ <- string "--"+--                       _ <- many (sat (\x -> x /= '\n'))+--                       return ()+comment            = do+                       bracket (string "/*") (many item) (string "*/")+                       return ()++junk              :: Parser ()+junk               = do {many (spaces +++ comment); return ()}++skip              :: Parser a -> Parser a+skip p             = do {junk; p}++token             :: Parser a -> Parser a+token p            = do {v <- p; junk; return v}++--- Token parsers ------------------------------------------------------------++natural           :: Parser Int+natural            = token nat++integer           :: Parser Int+integer            = token int++symbol            :: String -> Parser String+symbol xs          = token (string xs)++identifier        :: [String] -> Parser String+identifier ks      = token (do {x <- ident;+                                if not (elem x ks) then return x+                                else return MZERO})++------------------------------------------------------------------------------+-}
+ tools/Pattern.hs view
@@ -0,0 +1,245 @@+-- hat-observe permits matching of candidate equations against a pattern.+-- This requires a parser to convert a pattern from a string into an SExp,+-- and a comparison function on SExps.+module Pattern+  ( topMatchPat+  , matchPat+  , lexPat+  , parsePat+  ) where++import Prelude hiding (lex)+import Data.List	(isPrefixOf)+import Data.Char	(isDigit,isAlphaNum,isSpace,isUpper,isLower)+import SExp             (SExp(..),SFixity(..),QName(..),showQN)+import ParseLib++++-- Comparison of an expression against a pattern.+-- All SExp labels are ignored.+-- First arg is candidate, second is pattern.+matchPat :: SExp a -> SExp b -> Bool+matchPat _                 (SUnevaluated _)  = True+matchPat (SApp _ as)       (SApp _ bs)       = and (zipWith matchPat as bs)+matchPat (SId _ a _)       (SId _ b _)       = a==b+matchPat (SApp _ (a:_))  b@(SId _ _ _)       = matchPat a b+matchPat (SLiteral _ a)    (SLiteral _ b)    = a==b+matchPat (SString _ a _)    b                = matchString a b+matchPat (SLambda _)       (SLambda _)       = True+matchPat (SBottom _)       (SBottom _)       = True+matchPat (SEquation _ a b) (SEquation _ c d) = matchPat a c && matchPat b d+matchPat (SEquation _ a b) p                 = matchPat a p+matchPat (SFieldExpr _ e fs vs) (SFieldExpr _ e' f's v's) = matchPat e e'+                                                && matchFields (zip fs vs)+                                                               (zip f's v's)+matchPat (SFieldExpr _ e fs vs) (SApp _ (a:as)) = matchPat e a+                                                && and (zipWith matchPat vs as)+	-- above is only correct if applied field order matches pattern order+matchPat (SFieldExpr _ e fs vs) b@(SId _ _ _)= matchPat e b+matchPat _                 _                 = False++-- No matches for SWithin, SIf, SCase, SGuard, SCut, because+-- you can't specify such a pattern.++matchString :: String -> SExp a -> Bool+matchString []     (SId _ (Qualified _ "[]") _) = True+matchString (c:cs) (SApp _ [SId _ (Qualified _ ":") _, SLiteral _ c', tl]) =+        c' == show c  &&  matchString cs tl+matchString _      _ = False++matchFields :: [(String, SExp a)] -> [(String, SExp b)] -> Bool+matchFields candidate pattern =+    and (map (\ (f,e)-> case lookup f candidate of+                          Nothing -> False+                          Just e' -> matchPat e' e )+             pattern)++-- A toplevel match must not compare the fun position (to allow for+-- oversaturated CAF apps).+topMatchPat :: SExp a -> SExp b -> Bool+topMatchPat (SApp _ (a:as)) (SApp _ (b:bs))     = and (zipWith matchPat as bs)+topMatchPat (SEquation _ a b) (SEquation _ c d) = topMatchPat a c && matchPat b d+topMatchPat (SEquation _ a b) p                 = topMatchPat a p+topMatchPat a b                                 = matchPat a b+++-- Simple FSM lexer for patterns.+data Token+  = Variable QName+  | Constructor QName+  | InfixVariable QName+  | InfixConstructor QName+  | Numeric String+  | String String+  | Char String+  | OpenParen+  | CloseParen+  | OpenBracket+  | CloseBracket+  | Comma+  | Underscore+  | Bottom+  | Equal+  | In+  | OpenBrace+  | CloseBrace+  | End+  | Error String+  deriving (Eq)++gather :: (Char->Bool) -> (String->Token) -> (String->[Token])+                   -> String -> (String->[Token])+gather pred tok k acc [] = tok (reverse acc): k []+gather pred tok k acc (c:cs)+    | pred c    = tok (reverse acc): k (c:cs)+    | otherwise = gather pred tok k (c:acc) cs++lexPat :: String -> [Token]+lexPat [] = [End]+lexPat (x:xs)+  | x=='('     = OpenParen:    lexPat xs+  | x==')'     = CloseParen:   lexPat xs+  | x=='['     = OpenBracket:  lexPat xs+  | x==']'     = CloseBracket: lexPat xs+  | x=='{'     = OpenBrace:    lexPat xs+  | x=='}'     = CloseBrace:   lexPat xs+  | x==','     = Comma:        lexPat xs+  | x=='_' && "|_" `isPrefixOf` xs+               = Bottom:       lexPat (drop 2 xs)+  | x=='_' && (null xs || not (isVariable (head xs)))+               = Underscore:   lexPat xs+  | x=='=' && (null xs || not (isSymbol (head xs)))+               = Equal:        lexPat xs+  | x=='i' && "n " `isPrefixOf` xs+               = In:           lexPat (drop 2 xs)+  | isSpace x  = lexPat xs+  | isDigit x  = gather (not.isNumeric) Numeric lexPat [x] xs+  | isLower x || x=='_'		-- already checked for wildcard above+               = gather (not.isVariable) (plain Variable) lexPat [x] xs+  | isUpper x  = gather (not.isQVariable) qname lexPat [x] xs+  | isSymbol x = gather (not.isSymbol) (plain InfixVariable) lexPat [x] xs+  | x==':'     = gather (not.isSymbol) (plain InfixConstructor) lexPat [x] xs+  | x=='`'     = gather (=='`') (plain InfixVariable) (lexPat.tail) [] xs+  | x=='\''    = gather (=='\'') Char (lexPat.tail) [] xs+  | x=='"'     = gather (=='"') String (lexPat.tail) [] xs+  | otherwise  = [Error (x:xs)]++isSymbol, isNumeric, isVariable, isQVariable :: Char -> Bool+isSymbol x    = x `elem` "!#$%&*+./<=>?@\\^|-~"+isNumeric x   = isDigit x    || x `elem` ".eE"+isVariable x  = isAlphaNum x || x `elem` "_'"+isQVariable x = isVariable x || isSymbol x++plain :: (QName->Token) -> String -> Token+plain typ s = typ (Plain s)++qname :: String -> Token+qname str+  | null n'    = Constructor (Plain q)+  | isUpper c  = Constructor (Qualified q n)+  | isLower c || c=='_'+               = Variable (Qualified q n)+  | isSymbol c = InfixVariable (Qualified q n)+  | c==':'     = InfixConstructor (Qualified q n)+  | otherwise  = Error str+  where (q,n') = break (=='.') str+        n = tail n'+        c = head n++-- Parser from [Token] to SExp.+parsePat :: [Token] -> (Either String (SExp ()), Maybe QName)+parsePat tokens = case papply context tokens of+                    [((exp,ctx),[End])] -> (Right exp, ctx)+                    [(_,    [Error s])] -> (Left s,  Nothing)+                    _                   -> (Left "ambiguous", Nothing)++context  :: Parser Token (SExp (), Maybe QName)+context =+    do eqn <- equation+       ctx <- ( do tok In+                   Variable ctx  <- item+                   return (Just ctx) ) ++++              ( do return Nothing )+       return (eqn,ctx)+            +equation :: Parser Token (SExp ())+equation =+    do lhs <- pattern+       ( ( do tok Equal+              rhs <- pattern+              return (SEquation () lhs rhs) ) ++++         ( do return lhs ) )++pattern :: Parser Token (SExp ())+pattern =+  ( do tok OpenParen+       tok CloseParen+       return (SId () (Plain "()") SInfixDefault) ) ++++  ( do tok OpenParen+       (SId () v (SInfix 0)) <- atom+       tok CloseParen+       return (SId () v SInfixDefault) ) ++++  ( do tok OpenParen+       p <- pattern+       tok CloseParen+       return p ) ++++  ( do ps <- many1 atom+       ( let reorder xs =+                 case xs of+                     (p0:p1@(SId _ _ (SInfix _)):rs)+                           -> SApp () [p1,p0,reorder rs]+                     [p]   -> p+                     _     -> SApp () xs+         in return (reorder ps) ) )+  +atom :: Parser Token (SExp ())+atom =+  ( do String s <- item+       return (mkList (SLiteral () . show) s) ) ++++  ( do tok Underscore+       return (SUnevaluated ()) ) ++++  ( do Char c <- item+       return (SLiteral () ('\'':c++"'")) ) ++++  ( do Numeric n <- item+       return (SLiteral () n) ) ++++  ( do Constructor c <- item+       tok OpenBrace+       fields <- (do Variable name <- item+                     tok Equal+                     pat <- pattern+                     return (showQN False name,pat)) `sepby1` (tok Comma)+       tok CloseBrace+       let (names,exps) = unzip fields+       return (SFieldExpr () (SId () c SInfixDefault) names exps) ) ++++  ( do Constructor c <- item+       many ( do { tok OpenBrace; tok CloseBrace } )+       return (SId () c SInfixDefault) ) ++++  ( do Variable v <- item+       return (SId () v SInfixDefault) ) ++++  ( do InfixConstructor v <- item+       return (SId () v (SInfix 0)) ) ++++  ( do InfixVariable v <- item+       return (SId () v (SInfix 0)) ) ++++  ( do tok OpenParen+       ps <- pattern `sepby1` (tok Comma)+       tok CloseParen+       case length ps of+         1 -> return (head ps)+         _ -> let tuple = Plain (replicate (length ps - 1) ',')+              in return (SApp () (SId () tuple SInfixDefault: ps)) ) ++++  ( do tok OpenParen+       ps <- many1 atom+       tok CloseParen+       return (SApp () ps) ) ++++  ( do tok OpenBracket+       elems <- pattern `sepby` (tok Comma)+       tok CloseBracket+       return (mkList id elems) )++mkList :: (a->SExp ()) -> [a] -> SExp ()+mkList one []     = SId () (Plain "[]") SInfixDefault+mkList one (x:xs) = SApp () [ SId () (Plain ":") SInfixDefault +                            , one x+                            , mkList one xs ]+
+ tools/Pretty.hs view
@@ -0,0 +1,415 @@+module Pretty (PrettyOption(..), graphForNode, makeGraph) where++-- #if ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 604 ) \+--    || ( defined(__NHC__) && __NHC__ < 118 )+-- #define empty emptySet+-- #define toList setToList+-- #define insert addToSet+-- #define member elementOf+-- #endif++import LowLevel      (FileNode(..),nil,getParentNode,getSrcRef)+import CommonUI      (Options(..),Keep(..))+import NodeExp       (NodeExp(..),fullEval,flatEval,branches,result+                     ,removeResultCycles,removeNonResultCycles+                     ,nodeExp2SExp,getNode,CondType(..),getFirstCaredNode+                     ,flatEvalText,nodeExpForNode,fullEvalText,(===))+import SExp          (QName(..),showQN,prettySExp)+import qualified Data.Set as Set (empty, toList, insert, Set(..),member)+import ADT           (ADT(..),detectCycles,trustModule,trustIO,trustConstant+                     ,foldHiddens,trustUnevaluated,displayTrees)+import EDT           (buildEDT)+import SrcRef        (SrcRef(..), readSrcRef)++import Data.Char     (chr)+import Data.List     (sort)++import System.IO.Unsafe (unsafePerformIO)++-- #if ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 604 ) \+--     || ( defined(__NHC__) && __NHC__ < 118 )+-- addToSet :: Ord a => a -> Set.Set a -> Set.Set a+-- addToSet = flip Set.addToSet+-- setToList = Set.setToList+-- #else+addToSet :: Ord a => a -> Set.Set a -> Set.Set a+addToSet = Set.insert+setToList = Set.toList+-- #endif++data PrettyOption = ShowDecOffsets+                  | ShowHexOffsets+                  | ShowParents+                  | MkEDT+                  | MkFDT+                  | ShowSrcPoses+                  | ShowVersion+                  | ShowModule String+                  deriving Eq++parents :: [PrettyOption] -> Bool+parents = elem ShowParents++makeGraph :: NodeExp -> [PrettyOption] -> String+makeGraph n o = if MkEDT `elem` o+                  then+                    "digraph edt\n" +++                    "    {\n" +++                    "    ordering=out; rankstep=0.1;\n" +++                    (indent 4 (graphForEDT n o)) +++                    "    }\n"+                  else+                    "digraph trace\n" +++                    "    {\n" +++                    "    ordering=out; rankstep=0.1;\n" +++                    (indent 4 (graphForNode n o)) +++                    "    }\n"++indent :: Int -> String -> String+indent n = unlines . (map ((++) (take n (repeat ' ')))) . lines++graphForNode :: NodeExp -> [PrettyOption] -> String+graphForNode x o = (dotNodes y o) ++ (dotEdges y o)+                   where+                     y = moveToSet (removeNonResultCycles (removeResultCycles x)) Set.empty++graphForEDT :: NodeExp -> [PrettyOption] -> String+graphForEDT x o =+  (concat (map (flip dotADTNodes o) y)) +++  (concat (map (flip dotADTEdges o) y)) +  where+    y = (  trustConstant (Plain "otherwise")+         . trustModule "Prelude"+         . detectCycles+         . trustUnevaluated+         . trustIO+         . foldHiddens+         . buildEDT) $ removeNonResultCycles $ removeResultCycles x++moveToSet :: NodeExp -> Set.Set NodeExp -> Set.Set NodeExp+moveToSet n s+  | n `Set.member` s = s+  | otherwise = addToSet n $ foldr moveToSet s $ branches n++{-moveToSet' :: NodeExp -> Set.Set NodeExp -> Set.Set NodeExp+moveToSet' node@(NExpApp _ fun args res) set+  | (isVCycleOrApp res) && (getNode node) == (getNode res) && isId fun+    = if addToSet node (foldr moveToSet set args)+  | isId fun+    = addToSet node (moveToSet res (foldr moveToSet set args))+  | otherwise+    = addToSet node (moveToSet fun+                      (moveToSet res+                        (foldr moveToSet set args)))+moveToSet' node@(NExpConstUse _ def res) set+  = addToSet node (moveToSet res set)+moveToSet' node@(NExpConstDef _ def res) set+  = addToSet node (moveToSet res set)+moveToSet' node@(NExpCond _ _ cnd res) set+  = addToSet node (moveToSet cnd (moveToSet res set))+moveToSet' node@(NExpFieldExp _ field mappings) set+  = addToSet node (moveToSet field (foldr (moveToSet . snd) set mappings))+moveToSet' node@(NExpProjection _ res) set+  = addToSet node (moveToSet res set)+moveToSet' node@(NExpForward _ res) set+  = moveToSet res set+moveToSet' node@(NExpHidden _ children res) set+  = addToSet node (moveToSet res (foldr moveToSet set children))+moveToSet' node set+  = addToSet node set-}++isId :: NodeExp -> Bool+isId (NExpForward _ r) = isId r+isId (NExpIdentifier _ _ _) = True+isId _ = False++isVCycleOrApp (NExpResultCycle _) = True+isVCycleOrApp (NExpApp _ _ _ _) = True+isVCycleOrApp _ = False++dotNodes :: Set.Set NodeExp -> [PrettyOption] -> String+dotNodes s o+  = {-concatMap makeNode (setToList s)-}+    concatMap (\s -> "{rank=same; " ++ concatMap makeNode s ++ "}\n") (groupSets s)+    where+      groupSets :: Set.Set NodeExp -> [[NodeExp]]+      groupSets s = groupSets' $ sort $ setToList s+      +      groupSets' :: [NodeExp] -> [[NodeExp]]+      groupSets' [] = []+      groupSets' (x:xs) =+        (collected:groupSets' (filter (not . (`elem` collected)) xs))+        where+          collected = collectRs x []+      +      collectRs n v = if n `elem` v then []+                                    else n:collectRs (result n) (n:v)+            +      makeNode :: NodeExp -> String+      makeNode node@(NExpApp id fun args res)+        | (isVCycleOrApp res) && (getNode node) == (getNode res) && isId fun+          = mkNode id "ValApp" $ quote (flatEvalText 100 fun)+        | isId fun+          = let pos = getSrcRef id+            in mkNode id "Application" $ quote (flatEvalText 100 fun ++ if ShowSrcPoses `elem` o && pos /= LowLevel.nil then " - " ++ (formatSrcRef $ readSrcRef $ pos) else "")+        | otherwise+          = mkNode id "Application" ""+      makeNode node@(NExpConstUse id def res)+        = mkNode id "Constant Use" $ quote (showQN False def ++  if ShowSrcPoses `elem` o && pos /= LowLevel.nil then " - " ++ (formatSrcRef $ readSrcRef $ pos) else "")+          where pos = getSrcRef id+      makeNode node@(NExpConstDef id def res)+        = mkNode id "Constant Def" $ quote $ showQN False def+      makeNode node@(NExpIdentifier id _ _)+        = mkNode id "Identifier" $ quote (flatEvalText 100 node ++ if ShowSrcPoses `elem` o && pos /= LowLevel.nil then " - " ++ (formatSrcRef $ readSrcRef $ pos) else "")+          where pos = getSrcRef id+      makeNode node@(NExpLiteral id name)+        = mkNode id "Literal" $ quote (name ++ if ShowSrcPoses `elem` o && pos /= LowLevel.nil then " - " ++ (formatSrcRef $ readSrcRef $ pos) else "")+          where pos = getSrcRef id+      makeNode node@(NExpHidden id children res)+        = mkNode id "Hidden" ""+      makeNode node@(NExpProjection id res)+        = mkNode id "Projection" $ quote $ if ShowSrcPoses `elem` o && pos /= LowLevel.nil then formatSrcRef $ readSrcRef $ pos else ""+          where pos = getSrcRef id+      makeNode node@(NExpCond id gType cnd res)+        | gType == IfCond    = mkNode id "If" ""+        | gType == CaseCond  = mkNode id "Case" ""+        | gType == GuardCond = mkNode id "Guard" ""+      makeNode node@(NExpFieldExp id field mappings)+        = mkNode id "Field Expression" $ quote $ if ShowSrcPoses `elem` o then formatSrcRef $ readSrcRef $ getSrcRef id else ""+      makeNode node@(NExpInterrupt)+        = mkNode nil "^C" ""+      makeNode node@(NExpUneval)+        = mkNode nil "Unevaluated" ""+      makeNode node@(NExpBottom)+        = mkNode nil "_|_" ""+      makeNode node@(NExpNotShown)+        = mkNode nil "Not Shown" ""+      makeNode _ = ""+      +      mkNode :: FileNode -> String -> String -> String+      mkNode id lab ""+        | lab == "^C"          = insertOffset id+                                              "int [shape=diamond, label=\""+                                              "^C\"];\n"+        | lab == "_|_"         = insertOffset id+                                              "bot [shape=diamond, label=\""+                                              "_|_\"];\n"+        | lab == "Not Shown"   = insertOffset id+                                              "ns [shape=diamond, label=\""+                                              "Not Shown\"];\n"+        | otherwise+          = insertOffset id+                         ("x" ++ (show id)+                          ++ " [shape=box, label=\"")+                         (lab+                          ++ "\", fontname=\"Monaco\", fontsize=10];\n")+      mkNode id lab desc+        | lab == "ValApp" || lab == "Literal" || lab == "Identifier"+          = insertOffset id+                         ("x" ++ (show id)+                          ++ " [shape=ellipse, label=\"")+                         (desc+                          ++ "\", fontname=\"Monaco\", fontsize=10];\n")+        | otherwise+          = insertOffset id+                         ("x" ++ (show id)+                          ++ " [shape=record, label=\"{")+                         (lab+                          ++ " | "+                          ++ desc+                          ++ "}\", fontname=\"Monaco\", fontsize=10];\n")+      +      insertOffset :: FileNode -> String -> String -> String+      insertOffset node@(FileNode offset) start end+        = start+          ++ (if ShowDecOffsets `elem` o then show offset ++ " "+              else "")+          ++ (if ShowHexOffsets `elem` o then "0x" ++ show node ++ " "+              else "")+          ++ end+      +      writeRank :: FileNode -> String+      writeRank (FileNode x) = (show x)++dotADTNodes :: ADT -> [PrettyOption] -> String+dotADTNodes adt@(Branch _ node _ others) o+  = makeNode node ++ (concat $ map ((flip dotADTNodes) o) others)+    where+      makeNode :: NodeExp -> String+      makeNode node@(NExpApp id fun args res)+        = mkNode id "" $ filter (/= '\n') $ quote $ (flatEvalText 100 node ++ " ~> " ++ fullEvalText 100 node)+      makeNode node@(NExpConstUse id def res)+        = mkNode id "" $ filter (/= '\n') $ quote $ (showQN False def ++ " ~> " ++ fullEvalText 100 node)+      makeNode node@(NExpConstDef id def res)+        = mkNode id "" $ filter (/= '\n') $ quote $ (showQN False def ++ " ~> " ++ fullEvalText 100 node)+      makeNode node@(NExpInterrupt)+        = mkNode nil "^C" ""+      makeNode node@(NExpUneval)+        = mkNode nil "Unevaluated" ""+      makeNode node@(NExpBottom)+        = mkNode nil "_|_" ""+      makeNode node@(NExpNotShown)+        = mkNode nil "Not Shown" ""+      makeNode _ = ""+      +      mkNode :: FileNode -> String -> String -> String+      mkNode id lab ""+        | lab == "^C"          = insertOffset id+                                              "int [shape=diamond, label=\""+                                              "^C\"];\n"+        | lab == "_|_"         = insertOffset id+                                              "bot [shape=diamond, label=\""+                                              "_|_\"];\n"+        | lab == "Not Shown"   = insertOffset id+                                              "ns [shape=diamond, label=\""+                                              "Not Shown\"];\n"+        | otherwise+          = insertOffset id+                         ("x" ++ (show id)+                          ++ " [shape=box, label=\"")+                         (lab+                          ++ "\", fontname=\"Monaco\", fontsize=10];\n")+      mkNode id lab desc+        = insertOffset id+                       ("x" ++ (show id)+                       ++ " [shape=box, label=\"")+                       (desc+                       ++ "\", fontname=\"Monaco\", fontsize=10];\n")+      +      insertOffset :: FileNode -> String -> String -> String+      insertOffset node@(FileNode offset) start end+        = start+          ++ (if ShowDecOffsets `elem` o then show offset ++ " "+              else "")+          ++ (if ShowHexOffsets `elem` o then "0x" ++ show node ++ " "+              else "")+          ++ end+dotADTNodes adt@(Cycle _ nodes) o = ""++formatSrcRef :: SrcRef -> String+formatSrcRef SrcRef {filename = f, line = sl, column = sc, lineend = el, columnend = ec} =+  f ++ ":" ++ show sl ++ ":" ++ show sc ++ "-" ++ show el ++ ":" ++ show ec++dotEdges :: Set.Set NodeExp -> [PrettyOption] -> String+dotEdges s o+  = makeEdges (setToList s)+    where+      makeEdges :: [NodeExp] -> String+      makeEdges [] = ""+      makeEdges (x:xs) = makeEdge x ++ makeEdges xs+      +      makeEdge :: NodeExp -> String+      makeEdge node@(NExpApp id fun args res)+        | (isVCycleOrApp res) && (getNode node) == (getNode res) && isId fun+          =    (foldr ((++) . ((flip (mkEdge id)) "Arg")) "" args)+            ++ if (parents o) then (mkEdge (getParentNode id)+                                           node+                                           "Par")+                              else ""+        | isId fun+          =    (foldr ((++) . ((flip (mkEdge id)) "Arg")) "" args)+            ++ mkEdge id res "Res"+            ++ if (parents o) then (mkEdge (getParentNode id)+                                           node+                                           "Par")+                              else ""+        | otherwise+          =    mkEdge id fun "Fun"+            ++ (foldr ((++) . ((flip (mkEdge id)) "Arg")) "" args)+            ++ mkEdge id res "Res"+            ++ if (parents o) then (mkEdge (getParentNode id)+                                           node+                                           "Par")+                              else ""+      makeEdge node@(NExpConstUse id def res)+        =    mkEdge id res "Res"+          ++ if (parents o) then (mkEdge (getParentNode id)+                                         node+                                         "Par")+                            else ""+      makeEdge node@(NExpConstDef id def res)+        =    mkEdge id res "Res"+          ++ if (parents o) then (mkEdge (getParentNode id)+                                         node+                                         "Par")+                            else ""+      makeEdge node@(NExpCond id gType cnd res)+        =    mkEdge id cnd "Cond"+          ++ mkEdge id res "Res"+      {-makeEdge node@(NExpFieldExp id field mappings)+      -}+      makeEdge node@(NExpHidden id children res)+        =    (foldr ((++) . ((flip (mkEdge id)) "Chld")) "" children)+          ++ mkEdge id res "Res"+      makeEdge node@(NExpProjection id res)+        = mkEdge id res "Res"+      makeEdge node = ""++      mkEdge :: Show a => a -> NodeExp -> String -> String+      mkEdge src dst lbl+        =    "x" ++ (show src)+          ++ " -> "+          ++ "x" ++ (show (getNode (findChild dst)))+          ++ " ["+          ++ lineStyle lbl+          ++ "];\n"+          where+            lineStyle :: String -> String+            lineStyle "Fun"   = "style=dashed"+            lineStyle "Const" = "style=dashed"+            lineStyle "Res"   = "style=bold"+            lineStyle "Par"   = "style=dotted, dir=back"+            lineStyle "Arg"   = "arrowhead=inv"+            lineStyle "Cond"  = ""+            lineStyle "Chld"  = "arrowhead=inv"+            lineStyle x       = "label=\"" ++ x ++ "\""++dotADTEdges :: ADT -> [PrettyOption] -> String+dotADTEdges adt opts =+  concat $ zipWith mkADTEdge starts ends+  where+    (starts,ends) = unzip $ setToList $ edgeSet+    edgeSet = adtEdgeSet adt Set.empty++foldrM1 :: (a -> IO ()) -> [a] -> IO ()+foldrM1 f = foldr (\x y -> y >> f x) (return ())++adtEdgeSet :: ADT -> Set.Set (ADT,ADT) -> Set.Set (ADT,ADT)+adtEdgeSet adt@(Branch _ exp _ others) s+  = foldr (\x y -> addToSet (adt,x) y) addedSet others+    where+      addedSet = doSetAdds others+      doSetAdds [] = s+      doSetAdds (x:xs) = adtEdgeSet x (doSetAdds xs)+adtEdgeSet adt@(Cycle _ adts) s+  = foldr (\x y -> addToSet (adt,x) y) s adts++mkADTEdge :: ADT -> ADT -> String+mkADTEdge src@(Branch _ exp _ _) dst@(Branch _ exp' _ _)+  =    "x" ++ (show (getNode exp))+    ++ " -> "+    ++ "x" ++ (show (getNode exp')) ++ "\n"+mkADTEdge src@(Branch _ exp _ _) dst@(Cycle tag exps)+  = concatMap (mkADTEdge src) exps+mkADTEdge _ _ = ""++findChild :: NodeExp -> NodeExp+findChild (NExpForward _ res) = findChild res+-- findChild (NExpHidden _ children res) = findChild res+-- findChild (NExpProjection _ res) = findChild res+findChild x = x++bracket :: String -> String+bracket x = '(' : (x ++ ")")++quote :: String -> String+quote [] = []+quote (x:xs)+  | x == '{'   = "\\{" ++ quote xs+  | x == '}'   = "\\}" ++ quote xs+  | x == '"'   = "\\\"" ++ quote xs+  | x == '\\'  = "\\\\" ++ quote xs+  | x == '<'   = "\\<" ++ quote xs+  | x == '>'   = "\\>" ++ quote xs+  | x == '\27' = quote $ drop 1 $ dropWhile (/='m') xs+  | otherwise  = x : (quote xs)
+ tools/PrettyHat.hs view
@@ -0,0 +1,80 @@+module Main where++-- System Imports+import System.IO     (stdin,stdout,stderr,hPutStrLn)+import Data.List     (isSuffixOf)+import System.Cmd    (system)+import System.Environment (getArgs,getProgName)+import System.Exit   (exitWith,ExitCode(..))+import Foreign.C.String (withCString)+import Numeric       (showHex)++import LowLevel      (openHatFile,closeHatFile,FileNode(..),nil,peekTrace+                     ,getResult,getParentNode,getErrorLoc,getErrorMessage+                     ,getSrcRef,getDefnRef)+import NodeExp       (nodeExpForNode)+import Detect        (findMain)+import Pretty        (PrettyOption(..), makeGraph)++main = do args     <- System.Environment.getArgs+          prog     <- System.Environment.getProgName+          let opts = gatherOptions args+          let modNames = map getName (filter isModuleName opts)+          _ <- if modNames == []+                 then do hPutStrLn stderr (usage "no root module")+                         exitWith (ExitFailure 1)+                 else if ShowVersion `elem` opts+                   then do hPutStrLn stdout versionString+                   else return ()+          foldr (prettyFile prog opts) (return ()) modNames++prettyFile :: String -> [PrettyOption] -> String -> IO () -> IO ()+prettyFile prog opts x act =+  do act+     withCString prog (\p -> withCString (hatFile x) (openHatFile p))+     mainNode <- findMain+     writeFile (dotFile x) (makeGraph (nodeExpForNode mainNode) opts)+     closeHatFile++isModuleName :: PrettyOption -> Bool+isModuleName (ShowModule x) = True+isModuleName _ = False++getName :: PrettyOption -> String+getName (ShowModule x) = x++progName :: String+progName = "pretty-hat"++version :: Float+version = 0.1++versionString :: String+versionString = progName ++ " version: " ++ (show version) ++ "\n" +++                "(c) 2005 Thomas Davie\n"++usage :: String -> String+usage err = progName ++ ": " ++ err ++ "\n" +++            "usage: " ++ progName ++ " [MODULE]\n"++gatherOptions :: [String] -> [PrettyOption]+gatherOptions = map getOption++getOption :: String -> PrettyOption+getOption "-d" = ShowDecOffsets+getOption "-x" = ShowHexOffsets+getOption "-p" = ShowParents+getOption "-e" = MkEDT+getOption "-s" = ShowSrcPoses+getOption "-v" = ShowVersion+getOption x    = ShowModule x++dotFile :: FilePath -> FilePath+dotFile = (flip rectify) ".dot"++hatFile :: FilePath -> FilePath+hatFile = (flip rectify) ".hat"++rectify :: FilePath -> String -> FilePath+rectify f ext | ext `isSuffixOf` f = f+              | otherwise = f ++ ext
+ tools/PrettyLibHighlight.hs view
@@ -0,0 +1,483 @@+{-+A simple pretty printer combinator library.++(Extended to allow highlighting of arbitrary substructures of the document.)++A pretty printer converts an inductively defined data structure (i.e. a tree)+into a text (i.e. a list of lines).+Indentation of lines reflects the tree form of the data structure.+However, to produce only a minimal number of lines substructures are put+on a single line as far as possible.++The combinators provided here enable simple definition of a pretty printer +for any tree structure.+The pretty printer requires time linear in the size of the data structure+and space linear in the desired maximal width of the output.+The interface of the library is based on:+  Philip Wadler: A prettier printer, +  http://cm.bell-labs.com/cm/cs/who/wadler/topics/recent.html+The implementation uses some ideas from+  Derek C Oppen: Prettyprinting, TOPLAS volume 2 number 4, ACM, 1980, 465-483.+(Wadler's implementation performs some backtracking and hence may require time+linear in both the size of the data structure and the maximal width.)+-}+module PrettyLibHighlight+  ( nil,(<>),text,line,delimiter,fdelimiter,group,nest,groupNest,highlight+  , Doc+  , parens,brackets,braces,string+  , pretty,simple+  ) where++import HighlightStyle (highlightOn,highlightOff,Highlight(..))+++{- Exported definitions ================================================== -}+-- Core pretty printer combinators ------------------------------------------++infixr 6 <>++nil :: Doc+nil = NIL++(<>) :: Doc -> Doc -> Doc+(<>) = (:<>)++text :: String -> Doc+text = TEXT++delimiter :: String -> Doc+delimiter = DELIMITER++{- +Fill line, that is, +only make newline if part up to next possible newline does not fit on line.+-}+fdelimiter :: String -> Doc+fdelimiter = FDELIMITER++{-+Force line break. The surrounding groups cannot fit on one line.+-}+line :: Doc+line = LINE++group :: Doc -> Doc+group = GROUP++nest :: Int -> Doc -> Doc+nest = NEST++highlight :: [Highlight] -> Doc -> Doc+highlight = HIGHLIGHT++-- Derived pretty printer combinators ---------------------------------------++{-+The often used combination of group and nest.+-}+groupNest :: Int -> Doc -> Doc+groupNest indentation doc = group (nest indentation doc)+++doubleQuotes :: String -> Doc+doubleQuotes s = text ('"' : s ++ "\"")++parens :: Doc -> Doc+parens doc = text "(" <> doc <> text ")"++brackets :: Doc -> Doc+brackets doc = text "[" <> doc <> text "]"++braces :: Doc -> Doc+braces doc = text "{" <> doc <> text "}"++string :: String -> Doc+string s = text ('\"' : s ++ "\"")++{- Optimally pretty print the document within the given line width. -}+pretty :: Int -> Doc -> String+pretty width = layout width . normalise . removeFDelimiter . flatten ++{- Never turn a delimiter into a newline. -}++simple :: Doc -> String+simple = token2String . flatten+++{- Implementation ========================================================= -}++data Doc = NIL | Doc :<> Doc +         | TEXT String | DELIMITER String | FDELIMITER String | LINE +         | GROUP Doc | NEST Int Doc+         | HIGHLIGHT [Highlight] Doc+         deriving Show+++data Token = Text String Int +           | Delimiter String Int Int | FDelimiter String Int Int | Line Int +           | Open | Close		-- doc grouping+           | StartHiLite [Highlight] | EndHiLite [Highlight]+           deriving Show+++{- +Staightforward conversion of tokens into a string,+ignoring brackets and possiblity of turning delimiters into newlines.+-}+token2String :: [Token] -> String+token2String = t2s []+  where+    t2s hi [] = ""+    t2s hi (Text s _ : tokens) = s ++ t2s hi tokens+    t2s hi (Delimiter s _ _ : tokens) = s ++ t2s hi tokens+    t2s hi (FDelimiter s _ _ : tokens) = s ++ t2s hi tokens+    t2s hi (Line i : tokens) = '\n' : replicate i ' ' ++ t2s hi tokens+    t2s hi (Open : tokens) = t2s hi tokens+    t2s hi (Close : tokens) = t2s hi tokens+    t2s hi (StartHiLite h : tokens) = highlightOn h ++ t2s (h++hi) tokens+    t2s hi (EndHiLite h : tokens) = let hi' = drop (length h) hi in+                                    highlightOff ++ highlightOn hi'+                                    ++ t2s hi' tokens+ ++{-+Convert the tree structure of a document into a stream of tokens.+A group is repesented by an opening and a closing bracket.+-}+flatten :: Doc -> [Token]++flatten doc = go 0 doc []+  where+  go :: Int -> Doc -> [Token] -> [Token]+  {- use accumulator to perform flattening in linear time -}+  go i NIL rest = rest+  go i (d1 :<> d2) rest = go i d1 (go i d2 rest)+  go i (TEXT s) rest = Text s (length s) : rest+  go i (DELIMITER s) rest = Delimiter s (length s) i : rest+  go i (FDELIMITER s) rest = FDelimiter s (length s) i : rest+  go i LINE rest = Line i : rest+  go i (GROUP doc) rest = Open : go i doc (Close : rest)+  go i (NEST j doc) rest = go (i+j) doc rest+  go i (HIGHLIGHT h doc) rest = StartHiLite h : go i doc (EndHiLite h : rest)+++{-+Replace FDelimiter s l i by Open, Delimiter s l i, ..., Close.+So that Close is in front of the next (F)Delimiter s l i of the+same group or the next Close or the end.+-}+removeFDelimiter :: [Token] -> [Token]++removeFDelimiter = go 0 [] +  where+  {-+  Invariants: elements of stack are strictly sorted, largest on top+              nesting depth is greater or equal top element of stack (if ex.)+  -}+  go :: Int {- nesting depth of brackets; without new ones -}+     -> [Int] {- stack for closing brackets that still have to be inserted -}+     -> [Token] {- stream of tokens with FDelimiter -}+     -> [Token] {- stream of tokens without FDelimiter -}+  go _ [] [] = [] -- first argument should be 0+  go _ _  [] = [Close] -- the stack can at most contain one entry+  go d toClose (Open : tokens) = Open : go (d+1) toClose tokens+  go d toClose (Close : tokens) = +    possiblyClose (Close :) (subtract 1) id d toClose tokens+  go d toClose (FDelimiter s l i : tokens) =+    possiblyClose (\x -> Open : Delimiter s l i : x) id (d:) d toClose tokens+  go d toClose (Delimiter s l i : tokens) =+    possiblyClose (Delimiter s l i :) id id d toClose tokens+  go d toClose (Line i : tokens) =+    possiblyClose (Line i :) id id d toClose tokens+  go d toClose (text : tokens) = text : go d toClose tokens++  possiblyClose :: ([Token] -> [Token])  -- what to put into output stream+                -> (Int -> Int)          -- how to change nesting depth+                -> ([Int] -> [Int])      -- how to change stack+                -> Int                   -- nesting depth+                -> [Int]                 -- stack+                -> [Token]+                -> [Token]+  possiblyClose modOut modDepth modStack d (close : toClose) tokens+    | close == d = Close : modOut (go (modDepth d) (modStack toClose) tokens) +  possiblyClose modOut modDepth modStack d toClose tokens =+    modOut (go (modDepth d) (modStack toClose) tokens)+  ++{-+Normalise a stream of tokens wrt the following rewriting rules+  Open, Text s l  ==> Text s l, Open+  Close, Text s l ==> Text s l, Close+Then any block of brackets is followed by a Line s l i or the end of the stream+-}+normalise :: [Token] -> [Token]++normalise tokens = go 0 0 tokens+  where+  go :: Int {- number of deferred closing brackets -} +     -> Int {- number of deferred opening brackets -} +     -> [Token] {- stream of tokens to normalise -}+     -> [Token] {- normalised stream of tokens -}+  go i _ [] = replicate i Close -- there should be no deferred opening brackets+  go i j (Open : tokens) = go i (j+1) tokens+  go i j (Close : tokens)+    | j == 0    = go (i+1) j tokens+    | otherwise = go i (j-1) tokens+  go i j (deli@(Delimiter _ _ _) : tokens) =+    replicate i Close ++ replicate j Open ++ deli : go 0 0 tokens+  go i j (line@(Line _) : tokens) =+    replicate i Close ++ replicate j Open ++ line : go 0 0 tokens+  go i j (text : tokens) = text : go i j tokens+ ++{-+The list of tokens is optimally pretty printed within the given width.+Precondition: between a `Close' and a `Text s l' is always a `Line s l i'.+For efficiency also better if no `Open' is directly followed by `Text s l'.+A normalised token list has this property.+-}+layout :: Int {- width of layout -}+       -> [Token] +       -> String++layout width tokens = snd $ go width 1 empty1 0 [] tokens+  where+  go :: Int -- space remaining in current line (in characters)+     -> Int -- current stream position (in characters)+     -> Q1 Int -- queue of maximal streamposition for end of group to fit+     -> Int -- how deep inside a fitting group (<= 0: not in fitting group)+     -> [Highlight]  -- currently active highlighting+     -> [Token]+     -> (Q2 Bool -- queue which states if groups fit+        ,String) -- optimally layed-out output+  go _ _ groupsMaxEnd _ hi [] = (empty2, if null hi then "" else highlightOff)+  go r p groupsMaxEnd fitDepth hi (Open : tokens) = (groupFits', string)+    where+    (groupsMaxEnd', fits', groupFits') = cons (r+p) groupsMaxEnd groupsFits+    (groupsFits, string) = go r p groupsMaxEnd' fitDepth' hi tokens+    fitDepth' = if fitDepth > 0 then succ fitDepth else if fits' then 1 else 0+  go r p groupsMaxEnd fitDepth hi (Close : tokens) +    | isEmpty1 groupsMaxEnd = go r p groupsMaxEnd (pred fitDepth) hi tokens+    | otherwise = (groupFits', string)+    where+    (_, groupsMaxEnd', groupFits') = lview groupsMaxEnd True groupFits+    (groupFits, string) = go r p groupsMaxEnd' (pred fitDepth) hi tokens+  go r p groupsMaxEnd fitDepth hi (Delimiter s l i : tokens)  = +    (groupFits', output ++ string)+    where+    (output, newRemainingSpace) +      | fitDepth > 0 = (s, r-l)+      | otherwise    = (indent hi i, width-i)+    (groupFits', string) = +      checkGroupsMaxEnd newRemainingSpace (p+l) groupsMaxEnd fitDepth hi tokens +  go r p groupsMaxEnd fitDepth hi (Line i : tokens) =+    -- a compulsary newline makes all surrounding blocks not to fit+    (map1To2 (\_ -> False) groupsMaxEnd, indent hi i ++ string)+    where+    (_, string) = go (width-i) p empty1 fitDepth hi tokens+  go r p groupsMaxEnd fitDepth hi (Text s l : tokens) =+    (groupFits', s ++ string)+    where+    (groupFits', string) = +      checkGroupsMaxEnd (r-l) (p+l) groupsMaxEnd fitDepth hi tokens+  go r p groupsMaxEnd fitDepth hi (StartHiLite h: tokens) =+    (groupFits', highlightOn h ++ str)+    where (groupFits',str) = go r p groupsMaxEnd fitDepth (h++hi) tokens+  go r p groupsMaxEnd fitDepth hi (EndHiLite h: tokens) =+    (groupFits', highlightOff ++ highlightOn hi' ++ str)+    where (groupFits',str) = go r p groupsMaxEnd fitDepth hi' tokens+          hi' = drop (length h) hi+++  checkGroupsMaxEnd :: Int -> Int -> Q1 Int -> Int -> [Highlight] -> [Token] +                    -> (Q2 Bool, String)+  checkGroupsMaxEnd r p groupsMaxEnd fitDepth hi tokens +    | isEmpty1 groupsMaxEnd || p <= maxEnd = +      go r p groupsMaxEnd fitDepth hi tokens+    | otherwise = (groupsFits', string)+    where+    (groupsMaxEnd', maxEnd, groupsFits') = rview groupsMaxEnd groupsFits False+    (groupsFits,string) = checkGroupsMaxEnd r p groupsMaxEnd' fitDepth hi tokens++  indent hi i | null hi = '\n': replicate i ' '+              | otherwise = highlightOff++'\n':replicate i ' '++highlightOn hi+++{- Special double ended queues -------------------------------------------- ++Two related kinds of double ended queue types are defined.+A queue operation always operates on two queues, one of each kind.+Each operation performs an operation on one queue and exactly the inverse+operation on the other queue.+For example, an operation that splits one queue into its first element and+the remaining queue, also puts an element in front of the other queue to obtain+a longer queue.++The inverse operations are very lazy.+Let there be a sequence of queue operations such that the first queue +resulting from an operation is always the input first queue to the +*next* operation and the second queue resulting from an operation is always +the input second queue to the *preceding* operation.+Let the first operation `cons' an element to the front of the first queue +and the last operation remove exactly this element from the first queue +(either front or rear). Then the last operation adds another element to +the second queue and the first operation removes exactly this element.+The operations on the second queue are so lazy that for obtaining this +element the second queue which is input to the last operation is not+demanded, that is, does not need to be evaluated.++Note that the inverse operations only work correctly, if the two queues+are passed in such a sequence. The implementation does not only assume+that the two queues handled by an operation have the same number of elements,+but also that they have the same internal structure.++Using a monad to ascertain correct passing of queues is possible but +seems rather restrictive and hides the idea. However, maybe another+kind of sequencing interface would be good to ensure safe usage.++            element                            element+               v                                  ^+  queue1  -> +----+ -> +---------+ ->     -> +---------+ ->+             |cons|    |operation|    ...    |operation|+          <- +----+ <- +---------+ <-     <- +---------+ <- queue2+               v                                  ^+            element'                           element'++Except for the additional lazy inverse operations the implementation agrees +with the Banker's queue given in:+  Chris Okasaki: Purely Functional Data Structures, CUP, 1998, Section 8.4.2 +-}++{-+q12List (Q1 _ f _ r) = f ++ reverse r+Furthermore, the structure contains the lengths of the two lists+Q2 does not contain lengths+-}++data Q1 a = Q1 !Int [a] !Int [a] deriving Show+data Q2 a = Q2 [a] [a] deriving Show+++reverse1 :: Q1 a -> Q1 a+reverse1 (Q1 lenf f lenr r) = Q1 lenr r lenf f++reverse2 :: Q2 a -> Q2 a+reverse2 (Q2 f r) = Q2 r f+++empty1 = Q1 0 [] 0 []+empty2 = Q2 [] []+++isEmpty1 (Q1 lenf _ lenr _) = lenf + lenr == 0 +++map1To2 :: (a -> b) -> Q1 a -> Q2 b+map1To2 g (Q1 _ f _ r) = Q2 (map g f) (map g r)+++{-+Keep lengths of the two lists in balance+-}++check :: Int -> [a] -> Int -> [a] -> Q2 b -> (Q1 a, [b], [b])++check lenf f lenr r q2 =+  if lenf > balanceConstant * lenr + 1 then+    let+      len = lenf + lenr+      lenf' = len `div` 2+      lenr' = len - lenf'+      (f', rf') = splitAt lenf' f+      (r2, rf2) = lsplitAt lenr r2'+    in (Q1 lenf' f' lenr' (r ++ reverse rf')+       ,lappend lenf' f2' (lreverse (lenr'-lenr) rf2)+       ,r2)+   else+    (Q1 lenf f lenr r, f2', r2')+  where+  Q2 f2' r2' = q2+  balanceConstant = 3 :: Int+++{-+Put an element in front of the first list.+Inversely, split second list into front element and tail queue.+-}+cons :: a -> Q1 a -> Q2 b -> (Q1 a, b, Q2 b)++cons x (Q1 lenf f lenr r) q2' = (q', head f2, Q2 (tail f2) r2)+  where+  (q', f2, r2) = check (lenf+1) (x:f) lenr r q2'+++{-+Split first list into initial queue and rear element.+Inversely, add an element to rear of second list.+-}+rview :: Q1 a -> Q2 b -> b -> (Q1 a, a, Q2 b)++rview (Q1 _ (x:_) _ []) q2' y = (empty1, x, Q2 [y] [])+rview (Q1 _ [] _ []) _ _ = error "empty queue"+rview (Q1 lenf f lenr (x:r)) q2' y = (q', x, Q2 f2 (y:r2))+  where+  (q', f2, r2) = check lenf f (lenr-1) r q2'+++{-+Split first list into first element and tail queue.+Inversely, add an element to the front of the second list.+-}+lview :: Q1 a -> b -> Q2 b -> (a, Q1 a, Q2 b)++lview q1 y q2 = (x, reverse1 q1', reverse2 q2')+  where+  (q1', x, q2') = rview (reverse1 q1) (reverse2 q2) y+++{-+Some very lazy variants of standard list functions.+They get the length of the result or a list argument as first argument and +thus are able to construct the list structure of the result without demanding+evaluation of any of its other arguments.+Demanding some list element of the result will naturally lead to +more demand of the arguments.+-}+++{-+The first argument gives the length of the argument/result list.+-}+lreverse :: Int -> [a] -> [a]++lreverse n xs = lreverseAcc n xs []+  where+  lreverseAcc 0 _ acc = acc+  lreverseAcc n xs acc = lreverseAcc (n-1) ys (y:acc)+    where+    y:ys = xs++{-+The first argument gives the length of the first list argument.+-}+lappend :: Int -> [a] -> [a] -> [a]++lappend 0 _ zs = zs+lappend n xs zs = y : lappend (n-1) ys zs+  where+  y:ys = xs+++{-+The first argument gives the position at which the input list shall be split.+The list must be at least that long.+-}+lsplitAt :: Int -> [a] -> ([a], [a])+ +lsplitAt 0 xs = ([],xs)+lsplitAt n ys = (x:xs',xs'') +  where +  x:xs = ys+  (xs',xs'') = lsplitAt (n-1) xs++{- End PrettyLib ========================================================== -}
+ tools/Run.hs view
@@ -0,0 +1,51 @@+module Run+  ( runAndReadStdout+  , tmpfile+  ) where++import System.Directory (removeFile)+import System.Cmd       (system)+import System.Exit      (ExitCode(..))+import System.IO.Unsafe (unsafePerformIO)++-- #ifdef __HBC__+-- import UnsafePerformIO+-- #ifdef __HASKELL98__+-- import GetPid+-- getProcessID = getPid+-- #else+-- getProcessID = return 3154      -- arbitrary number+-- #endif+-- #endif+-- #ifdef __NHC__+-- import FFIExtensions (unsafePerformIO)+-- foreign import ccall "getpid" getProcessID :: IO Int+-- #endif+-- #ifdef __GLASGOW_HASKELL__+-- import FFIExtensions (unsafePerformIO)+-- foreign import ccall "getpid" getProcessID :: IO Int+-- #endif+foreign import ccall "getpid" getProcessID :: IO Int++-- Generate a temporary filename unique to this process.+tmpfile :: String -> String+tmpfile root = unsafePerformIO $ do p <- getProcessID+                                    return ("/tmp/"++root++"."++show p)++-- Run a shell command and collect its output.+runAndReadStdout :: String -> IO String+runAndReadStdout cmd = do+    let output = tmpfile "hmakeconfig"+    err <- system (cmd++" >"++output)+    case err of+        ExitFailure _ -> ioError (userError ("Command ("++cmd++") failed"))+        _ -> return ()+    s <- readFile output+    removeFile output   -- file will not be removed until readFile closes it+    return (safeinit s) -- strip trailing newline added by shell+  where+    safeinit []     = []+    safeinit ['\n'] = []+    safeinit [x]    = [x]+    safeinit (x:xs) = x : safeinit xs+
+ tools/SExp.hs view
@@ -0,0 +1,951 @@+-- Pretty printing of an ART expression with a sub-expression highlit.+-- First convert a value (basically a FileNode) into an S-expression,+-- then convert the S-expression to a Doc for pretty printing.+module SExp+  ( SExp(..)+  , SFixity(..), transFixity -- used only in module Pattern+  , Label+  , QName(..), showQN+  , fileNode2SExp+  , optParens+  , schemeParens+  , notCondParens+  , sExp2Doc+  , arity, child, label, children, rebuild, parent, prune+  , funId, funLabel+  , prettyExpression+  , prettySExp+  , prettyEquation+  , prettyEquation2+  ) where++import LowLevel hiding    (nil)+import qualified LowLevel (nil)+import HighlightStyle     (Highlight(..),Colour(..))+import PrettyLibHighlight as Pretty+                          (Doc,text,(<>),delimiter,fdelimiter,nil,group,parens+                          ,groupNest,pretty,highlight)+import CommonUI           (Options(..))+import Data.Char          (isAlpha)+import Data.List          (unzip3,isPrefixOf)+import System.IO          (hPutStrLn,stderr)+import System.IO.Unsafe  (unsafePerformIO)+import Numeric            (showHex)++bold = highlight [Bold, Foreground Blue]++errorT  :: String -> a+errorT s = unsafePerformIO (do hPutStrLn stderr s; return (error ""))+debug  :: (Show a) => a -> String -> a+x `debug` s = unsafePerformIO (do hPutStrLn stderr (s++show x); return x)++data QName+  = Plain String+  | Qualified String String+  deriving Show++instance Eq QName where+  Plain v       == Plain v'         =   v==v'+  Qualified q v == Plain v'         =   v==v'+  Plain v       == Qualified q' v'  =   v==v'+  Qualified q v == Qualified q' v'  =   v==v' && q==q'++showQN :: Bool -> QName -> String+showQN _ (Plain n)           = showString n ""+showQN False (Qualified q n) = showString n ""+showQN True  (Qualified q n) = (showString q . showChar '.' . showString n) ""++type Label = (String,FileNode)	-- The label on an SExp contains two components,+				-- a unique string, and the file pointer.+				-- The former enables unique highlighting, and+				-- the latter enables highlighting of sharing.++data SExp a+  = SApp a [SExp a]		-- n-ary application of at least 2 expressions+  | SId a QName SFixity		-- an identifier (variable or constructor)+  | SLiteral a String		-- any other kind of basic value+  | SString a String Ellipsis	-- character strings have special sugar+  | SWithin a [SExp a]		-- chains of if/case/guard inside an expression+  | SLambda a			-- a lambda expression+  | SDoLambda a			-- (internal) the lambda binding in a do stmt+  | SDoStmt a a (SExp a) (SExp a) -- do { val <- stmt }+  | SIf a (SExp a) (Maybe (SExp a))	-- possibly contains result+  | SCase a (SExp a) (Maybe (SExp a))+  | SGuard a (SExp a) (Maybe (SExp a))+  | SFieldExpr a (SExp a) [String] [SExp a]+				-- constructor value, or update+  | SCut a			-- cut off subexpression (to limit depth)+  | SUnevaluated a		-- underscore+  | SInterrupted a		--  ^C  (expr entered but never completed)+  | SBottom a			-- _|_  (expr entered but never completed)+  | SCycle a String (SExp a)	-- cyclic expression shown as `id where id = ..'+  | SEquation a (SExp a) (SExp a)+			-- an equation only makes sense as the root of an SExp+  | SParens a (SExp a) Int	-- parenthesised expr+  | SInfinite a+  | SFiniteMap a [([SExp a],SExp a)]+   deriving Show		-- only for testing/debugging++type Ellipsis = Bool		-- is a character string truncated?++data SFixity = +  SInfix Int | SInfixL Int | SInfixR Int | SAssoc Int String | SInfixDefault+  -- need own type for some hardcoded operators that are known to be+  -- semantically associative+  deriving (Show)++-- translate fixity from the file representation to the structured fixity type+transFixity :: Int -> SFixity+transFixity f = case f `divMod` 4 of+                  (p,0) -> SInfix p+                  (p,1) -> SInfixR p+                  (p,2) -> SInfixL p+                  (p,3) -> SInfixDefault++-- arity of an S-expression+arity :: SExp a -> Int+arity (SApp _ exps)     = length exps+arity (SWithin _ exps)  = length exps+arity (SIf _ _ _)       = 1+arity (SCase _ _ _)     = 1+arity (SGuard _ _ _)    = 1+arity (SEquation _ _ _) = 2+arity (SFieldExpr _ _ _ upds) = 1 + length upds+arity (SDoStmt _ _ _ _) = 3+arity _                 = 0++-- get child of an S-expression+-- precondition: i < arity exp+child :: Int -> SExp a -> SExp a+child i (SApp _ exps)    = skipCaseIfGuard (exps!!i)+child i (SWithin _ exps) = skipCaseIfGuard (exps!!i)+--child 0 (SIf _ exp)      = exp+--child 0 (SCase _ exp)    = exp+--child 0 (SGuard _ exp)   = exp+child 0 (SEquation _ l r) = l+child 1 (SEquation _ l r) = r+child 0 (SFieldExpr _ e _ upds) = e+child i (SFieldExpr _ e _ upds) = upds!!(i-1)+child 0 (SDoStmt _ m _ _) = SLambda m+child 1 (SDoStmt _ _ v _) = v+child 2 (SDoStmt _ _ _ a) = a+child i exp               = errorT ("SExp.child: "++show i++" is too large.")++skipCaseIfGuard (SIf _ exp _) = exp+skipCaseIfGuard (SCase _ exp _) = exp+skipCaseIfGuard (SGuard _ exp _) = exp+skipCaseIfGuard exp = exp++label :: SExp a -> a+label (SApp l _)      = l+label (SId l _ _)     = l+label (SLiteral l _)  = l+label (SString l _ _) = l+label (SLambda l)     = l+label (SWithin l _)   = l+label (SIf l _ _)     = l+label (SCase l _ _)   = l+label (SGuard l _ _)  = l+label (SCut l)        = l+label (SUnevaluated l)= l+label (SInterrupted l)= l+label (SBottom l)     = l+label (SCycle l _ _)  = l+label (SDoStmt l _ _ _) = l+label (SEquation l _ _) = l+label (SFieldExpr l _ _ _) = l++children :: SExp a -> [SExp a]+children (SApp _ es)             = es+children (SWithin l es)          = es+children (SIf _ e _)             = [e]+children (SCase _ e _)           = [e]+children (SGuard _ e _)          = [e]+children (SCycle _ _ e)          = [e]+children (SEquation _ e r)       = [e,r]+children (SFieldExpr _ e _ upds) = e: upds+children (SDoStmt _ m e p)       = [SDoLambda m,e,p]+children _                       = []++rebuild :: SExp a -> [SExp a] -> SExp a+rebuild (SApp l _)       es = SApp l es+rebuild (SWithin l _)    es = SWithin l es+rebuild (SIf l _ r)     [e] = SIf l e r+rebuild (SCase l _ r)   [e] = SCase l e r+rebuild (SGuard l _ r)  [e] = SGuard l e r+rebuild (SCycle l v _)  [e] = SCycle l v e+rebuild (SEquation l _ _) [e,r] = SEquation l e r+rebuild (SFieldExpr l _ labs _) (e:upds) = SFieldExpr l e labs upds+rebuild (SDoStmt l _ _ _) [SDoLambda m,e,p] = SDoStmt l m e p+rebuild sexp             _  = sexp++relabel :: a -> SExp a -> SExp a+relabel l (SApp _ es)       = SApp l es+relabel l (SId _ v f)       = SId l v f+relabel l (SLiteral _ s)    = SLiteral l s+relabel l (SString _ s d)   = SString l s d+relabel l (SLambda _)       = SLambda l+relabel l (SDoLambda _)     = SDoLambda l+relabel l (SWithin _ e)     = SWithin l e+relabel l (SIf _ e r)       = SIf l e r+relabel l (SCase _ e r)     = SCase l e r+relabel l (SGuard _ e r)    = SGuard l e r+relabel l (SCut _)          = SCut l+relabel l (SUnevaluated _)  = SUnevaluated l+relabel l (SInterrupted _)  = SInterrupted l+relabel l (SBottom _)       = SBottom l+relabel l (SCycle _ a b)    = SCycle l a b+relabel l (SDoStmt _ m e p) = SDoStmt l m e p+relabel l (SEquation _ e r) = SEquation l e r+relabel l (SFieldExpr _ e labs upds) = SFieldExpr l e labs upds++parent :: SExp Label -> FileNode+parent (SWithin _ (x:_)) = parent x+parent (SEquation _ x _) = parent x+parent x                 = getParentNode (snd (label x))++prune :: Int -> SExp a -> SExp a+prune 0 s = SCut (label s)+prune n (SApp a es) = SApp a (head es: map (prune (n-1)) (tail es))+prune n (SWithin a es) = SWithin a (head es: map (prune (n-1)) (tail es))+prune n (SEquation a lhs rhs) = SEquation a (prune n lhs) (prune n rhs)+prune n s = s++funId :: SExp a -> QName+funId (SApp _ es) = funId (head es)+funId (SWithin _ es) = funId (head es)+funId (SEquation _ e _) = funId e+funId (SFieldExpr _ e _ _) = funId e+funId (SString _ _ _) = Qualified "Prelude" ":"+funId (SLambda _) = Plain "(\\..)"+funId (SDoStmt _ _ _ _) = Plain "do"+funId (SId _ s _) = s+funId _ = Plain ""++funLabel :: SExp Label -> FileNode+funLabel (SApp _ es) = funLabel (head es)+funLabel (SWithin _ es) = funLabel (head es)+funLabel (SEquation _ e _) = funLabel e+funLabel (SFieldExpr _ e _ _) = funLabel e+funLabel (SString (_,n) _ _) = n+funLabel (SDoStmt _ (_,n) _ _) = n+funLabel (SLambda (_,n)) = n+funLabel (SId (_,n) _ _) = n+funLabel _ = LowLevel.nil++fst3 (x,_,_) = x+snd3 (_,x,_) = x+thd3 (_,_,x) = x++-- conversion function+-- If `uneval' boolean is True, then unevaluated arguments appear in full+-- in the result, otherwise they are represented by SUnevaluated.+fileNode2SExp :: Int -> Bool -> Bool -> Bool -> Label -> SExp Label+fileNode2SExp cutoff uneval strings toplevelLHS labl =+  case go cutoff uneval strings toplevelLHS [] labl of (e,_,_) -> e  +  where+  simple e = (e,[],[])+  go :: Int	            -- cutoff depth+     -> Bool                -- show unevaluated args in full?+     -> Bool                -- sugar character strings?+     -> Bool                -- top-level LHS? (implies uneval to one level)+     -> [(FileNode,String)] -- enclosing nodes w/ variable name for `where'+     -> Label               -- root node of expression+     -> ( SExp Label        -- expression +        , [FileNode]        -- nodes that start cycle+        , [String] )        -- variable names occurring (except for cycles)+  go 0     uneval strings top nodesAbove labl = simple (SCut labl)+  go depth uneval strings top nodesAbove labl@(lab,node) =+    if      node == LowLevel.nil then simple $ SUnevaluated labl+    else if node == unevaluated then simple $ SUnevaluated labl+    else if node == entered then simple $ SBottom labl+    else if node == interrupted then simple $ SInterrupted labl+    else if node == lambda then simple $ SLambda labl+    else if node == dolambda then simple $ SDoLambda labl+    else+    let r = peekResult node in+    if  r == unevaluated && not (uneval||top) then simple $ SUnevaluated labl+    else if r == entered && not top then simple $ SBottom labl+    else if r == interrupted && top then simple $ SInterrupted labl+    else if r == lambda && not uneval then simple $ SLambda labl+    else if r == dolambda && not uneval then simple $ SDoLambda labl+    else case simpleNodeType node of+      NodeModule -> "got a Module" `errorAt` node+      NodeSrcPos -> "got an SrcPos" `errorAt` node+      NodeAtom -> -- "got an Atom" `errorAt` node+        let i = getAtom node+            m = getAtomMod node+        in simple (SId labl (Qualified m i) (transFixity (getAtomFixity node)))+      NodeApplication -> +        let partCycles :: [FileNode]+            partCycles = (funCycles ++ concat argsCycles)+            partVars :: [String]+            partVars = funVars ++ concat argsVars+            isCycle = node `elem` partCycles+            var :: String+            var = head . filter (not . (`elem` partVars)) .+                  map (("cyc"++) . show) $ [1..] +            newNodesAbove :: [(FileNode,String)]+            newNodesAbove = (node,var) : nodesAbove+            subExps :: [FileNode]+            subExps = getSubExprs node+            -- (fun,funCycles,funVars) = ... not accepted by nhc98+            fun = fst3 z+            funCycles = snd3 z+            funVars = thd3 z+            z = let f = head subExps in+                if f==LowLevel.nil then simple (SCut ('f':lab,f))+                else go depth uneval strings False newNodesAbove ('f':lab,f)+            args = fst3 zs+            argsCycles = snd3 zs+            argsVars = thd3 zs+            -- (args,argsCycles,argsVars) = ... not accepted by nhc98+            zs = unzip3 $ map (go (depth-1) uneval strings False newNodesAbove)+                              (zipWith lbl ['1'..] (tail subExps))+            lbl c n = (c:lab, n)+            -- To do strings right, need to peek one level inside a cons.+            z1 = go 1 uneval strings False newNodesAbove+                 ('1':lab, subExps!!1)	-- only used in string cutoff case+            z2 = go 3 uneval strings False newNodesAbove+                 ('2':lab, subExps!!2)	-- only used in string cutoff case++            sexp = case fun of+              -- convert the representation of constructors with fields+              SId n@(_,m) c _ | isConstrFields m ->+                SFieldExpr labl (SId n c SInfixDefault)+                                 (getFieldLabels m) args+              -- convert char-list into string+              SId _ (Qualified _ ":") _ | strings && length args == 2 ->+                case args!!0 of+                  SLiteral _ c | not (null c) && head c == '\'' ->+                    case args!!1 of+                      SId _ (Qualified _ "[]") _+                                    -> SString labl (init (tail c)) False+                      SString _ s d -> SString labl (init (tail c)++s) d+                      _             -> SApp labl (fun:args)+                  SCut _ ->	-- peek beyond the cut+                    case fst3 z1 of+                      SLiteral _ c | not (null c) && head c == '\'' ->+                        case fst3 z2 of+                          SId _ (Qualified _ "[]") _+                             -> SString labl (init (tail c)) False+                          _  -> SString labl (init (tail c)) True+                      _ -> SApp labl (fun:args)+                  _ -> SApp labl (fun:args)+              -- different bracketing of a char-list+              SApp _ args1@[SId _ (Qualified _ ":") _,SLiteral _ c]+                | strings && length args == 1+                && not (null c) && head c == '\'' ->+                    case args!!0 of+                      SId _ (Qualified _ "[]") _+                                    -> SString labl (init (tail c)) False+                      SString _ s d -> SString labl (init (tail c)++s) d+                      _             -> SApp labl (args1++args)+              SApp _ args1@[SId _ (Qualified _ ":") _,SCut _]+                | strings && length args == 1 ->+                    fst3 (go (depth+1) uneval strings False nodesAbove labl)+              -- combine applications+              SApp n args1 -> SApp labl (args1++args)+              -- convert DoLambda to DoStmt+        --    SDoLambda n -> let binding = args!!0 in+              SId n (Qualified _ "do") _ ->+                    let binding = args!!0+                        bindingFN = snd (label binding)+                        nearestEnclosing node =+                            let par = getParentNode node+                                res = getResult par False+                            in if res==bindingFN+                               then nearestEnclosing par else res+                    in+                    SDoStmt labl n binding+                            (fst3 (go depth uneval strings top []+                                      ("d",(nearestEnclosing bindingFN))))+              -- anything else is just a simple application+              _ -> SApp labl (fun:args)+        +        -- Check for cycles in the application and return appropriately.+        -- The case for no cycles is Nothing then the else branch.+        in case lookup node nodesAbove of+             Just var -> (SId labl (Plain var) SInfixDefault,[node],[]) +                         -- `lower' end of cycle+             Nothing  -> ( if isCycle then SCycle (lab,node) var sexp else sexp+                         , partCycles+                         , partVars)+      NodeBasicValue ->+          let i = getValue node in simple $ SLiteral labl i+      NodeIdentifier ->+          if isLambda node then simple (SLambda labl) else+          let i = getValue node+              m = getValueMod node+          in+          ( SId labl (Qualified m i) (case i of+                           "."  | m == "Prelude" -> SAssoc 9 i+                           "++" | m == "Prelude" -> SAssoc 5 i+                           "&&" | m == "Prelude" -> SAssoc 3 i+                           "||" | m == "Prelude" -> SAssoc 2 i+                           "*"  | m == "Prelude" -> SAssoc 7 i+                           "+"  | m == "Prelude" -> SAssoc 6 i+                           ">>" | m == "Prelude" -> SAssoc 1 i+                           ">>=" | m == "Prelude" -> SAssoc 1 i+                           _ -> transFixity (getFixity node))+          , []+          , if isConstructor node then [] else [i] )+      NodeCAF ->+          let i = getValue node+              m = getValueMod node+          in simple (SId labl (Qualified m i) (transFixity (getFixity node)))+      NodeConditional ->+          let skind = case nodeType node of+                          ExpGuard -> SGuard+                          ExpCase  -> SCase+                          ExpIf    -> SIf+              within :: Label -> (SExp Label->Maybe (SExp Label)->SExp Label)+                        -> SExp Label -> SExp Label -> SExp Label+              within labl kind parent exp =+                case parent of	-- eliminate chains of SWithin+                    SWithin _ ps -> SWithin labl (ps++[kind exp Nothing])+                    _            -> SWithin labl [parent,kind exp Nothing]+          in simple $+             within labl (skind ('c':lab,node))+                          (fileNode2SExp depth uneval strings True+                                         ('w':lab, getParentNode node))+                          (fileNode2SExp depth uneval strings False+                                         ('v':lab, head (getSubExprs node)))+      NodeSugar -> -- simple $ SLiteral labl "{sugar}"+          case nodeType node of+            ExpDoStmt -> simple $ SLiteral labl "{do stmt}"+            ExpFieldUpdate ->+                let (exp:updValues) = getSubExprs node+                    updLabels = getFieldLabels node+                in simple $+                   SFieldExpr labl+                              (fileNode2SExp (depth-1) uneval strings False+                                             ('u':lab, exp))+                              updLabels+                              (map (fileNode2SExp (depth-1) uneval+                                                  strings False)+                                   (zipWith (\i v-> (i:lab, v))+                                            ['1'..] updValues))+      NodeSpecial ->+          case nodeType node of+            ExpProjection ->+                (\(exp,x,y) -> (relabel ('p':lab,node) exp, x, y) ) $+                go depth uneval strings False nodesAbove+                   ('p':lab, getResult (head (getSubExprs node)) top)+            ExpHidden -> +                simple $ SLiteral labl "{?}"+            ExpForward ->+                go depth uneval strings False nodesAbove+                   (lab, head (getSubExprs node))++  errorAt :: String -> FileNode -> a+  errorAt str node = errorT ("SExp: "++str++" at 0x"++showHex (int node) "")+++-- useful document combinators:+-- non-breaking space+(<->) :: Doc -> Doc -> Doc+d1 <-> d2 = d1 <> delimiter " " <> d2 ++-- breakable space+(<+>) :: Doc -> Doc -> Doc+d1 <+> d2 = d1 <> fdelimiter " " <> d2++-- breakable non-space+(<|>) :: Doc -> Doc -> Doc+d1 <|> d2 = d1 <> fdelimiter "" <> d2++-- breakable before a comma+(<*>) :: Doc -> Doc -> Doc+d1 <*> d2 = d1 <|> text "," <> d2++-- breakable before or after a cons+(<:>) :: Doc -> Doc -> Doc+d1 <:> d2 = d1 <|> text ":" <|> d2++indentation :: Int+indentation = 2+++isOpSym :: String -> Bool+isOpSym ""  = True	-- representation of the unit value ()+isOpSym sym = let c = head sym in+              not (isAlpha c || c `elem` "[_{" || sym == "(\\..)") ++funDoc :: Bool -> QName -> Doc+funDoc q qn = (if isOpSym var then parens else id) $ text (showQN q qn)+  where var = case qn of Plain v -> v; Qualified _ v -> v++opDoc :: Bool -> QName -> Doc+opDoc q qn =  text (if isAlpha (head var) then ('`' :showQN q qn++ "`")+                    else showQN q qn)+  where var = case qn of Plain v -> v; Qualified _ v -> v+++data ArgPos = ALeft | ARight+isRight ARight = True+isRight ALeft = False+isLeft = not . isRight++-- surround by parentheses if necessary+-- first fixity of surrounding expression, then if left or right argument,+-- then fixity of expression itself+optParens :: SFixity -> ArgPos -> SFixity -> Doc -> Doc+optParens surFixity aPos ownFixity =+  case (priority surFixity) `compare` (priority ownFixity) of+    LT -> if priority surFixity == (-1) then groupNest indentation else id+    GT -> groupNest indentation . parens+    EQ -> if (isInfixR surFixity && isInfixR ownFixity && isRight aPos)+            || (isInfixL surFixity && isInfixL ownFixity && isLeft aPos)+            || sameAssoc surFixity ownFixity +            then id+            else groupNest indentation . parens++{-+minimalParens :: Parenthesiser+minimalParens (SApp va (id@(SId vt (Qualified _ (',':xs)) _):args))+  = if length xs + 2 != length args+      then SParens va (SApp va (minParens id):(map minParens args))+      else SApp va (minParens id):(map minParens args)+-}+schemeParens :: SExp a -> SExp a+schemeParens = par 0+  where+    par :: Int -> SExp a -> SExp a+    par d (SApp a xs)         = SParens a (SApp a (map (par (d+1)) xs)) d+    par d (SWithin a xs)      = SWithin a (map (par (d+1)) xs)+    par d (SDoStmt a b xa xb) = SParens a (SDoStmt a b (par (d+1) xa)+                                                       (par (d+1) xb)) d+    par d (SIf a c r)         = SParens a (SIf a (par (d+1) c) r) d+    par d (SCase a c r)       = SParens a (SCase a (par (d+1) c) r) d+    par d (SGuard a c r)      = SParens a (SGuard a (par (d+1) c) r) d+    par d (SFieldExpr a x ms bs) = SParens a (SFieldExpr a (par (d+1) x) ms+                                                         (map (par (d+1)) bs)) d+    par d (SCycle a s x)      = SCycle a s (par d x)+    par d (SEquation a x y)   = SParens a (SEquation a (par (d+1) x)+                                                       (par (d+1) y)) d+    par _ x = x++notCondParens :: SExp a -> SExp a+notCondParens = par 0+  where+    par d (SApp a xs)         = SApp a (map (allow d) xs)+    par d (SWithin a xs)      = SWithin a (map (allow d) xs)+    par d (SDoStmt a b xa xb) = SDoStmt a b (allow d xa) (allow d xb)+    par d (SIf a c r)         = SIf a (par d c) r+    par d (SCase a c r)       = SCase a (par d c) r+    par d (SGuard a c r)      = SGuard a (par d c) r+    par d (SFieldExpr a x ms bs) = SFieldExpr a (allow d x) ms+                                              (map (allow d) bs)+    par d (SCycle a s x)      = SCycle a s (allow d x)+    par d (SEquation a x y)   = SEquation a (allow d x) (allow d y)+    par _ x = x++    allow d (SApp a xs)         = SParens a (SApp a (map (allow (d+1)) xs)) d+    allow d (SWithin a xs)      = SWithin a (map (allow d) xs)+    allow d (SDoStmt a b xa xb) = SDoStmt a b (allow d xa) (allow d xb)+    allow d (SIf a c r)         = SParens a (SIf a (par (d+1) c) r) d+    allow d (SCase a c r)       = SParens a (SCase a (par (d+1) c) r) d+    allow d (SGuard a c r)      = SParens a (SGuard a (par (d+1) c) r) d+    allow d (SFieldExpr a x ms bs) = SFieldExpr a (allow d x) ms+                                                (map (allow d) bs)+    allow d (SCycle a s x)      = SCycle a s (allow d x)+    allow d (SEquation a x y)   = SParens a (SEquation a (allow (d+1) x)+                                                         (allow (d+1) y)) d+    allow _ x = x+++sameAssoc :: SFixity -> SFixity -> Bool+sameAssoc (SAssoc _ var1) (SAssoc _ var2) = True+sameAssoc _ _ = False++foldr0 :: (a -> a -> a) -> a -> [a] -> a+foldr0 f c [] = c+foldr0 f c xs = foldr1 f xs++listDoc :: (Show a, Eq a) => Bool -> (a->Doc->Doc) -> SFixity -> ArgPos -> SExp a -> Doc+listDoc qual high surFixity aPos e =+  group $ text "[" <> commas e+  where+  commas = sExpFold (sExp2Doc False True qual high) (text ",") (text "]")++  sExpFold head cons nil (SApp v [SId c (Qualified _ ":") _, hd+                                 , SId n (Qualified _ "[]") _]) =+      high v (head hd <|> high c (high n nil))+  sExpFold head cons nil (SApp v [SId c (Qualified _ ":") _, hd+                                 , SId n (Plain cyc) _])+      | "cyc" `isPrefixOf` cyc =+      high v (head hd <|> high c cons <|> high n (text (cyc++"..."))+      <|> high c (high n nil))+  sExpFold head cons nil (SApp v [SId c (Qualified _ ":") _+                                 , hd@(SCut t), SCut n]) =+      high v (head hd <> high c (high t (text "...")) <|> high n nil)+  sExpFold head cons nil (SApp v [SId c (Qualified _ ":") _, hd, tl]) =+      high v (head hd <|> high c cons <|> sExpFold head cons nil tl)+  sExpFold head cons nil (SId n (Qualified _ "[]") _) =+      high n nil+  sExpFold head cons nil e@(SUnevaluated _) =+      sExp2Doc False True qual high e <|> nil+  sExpFold head cons nil e@(SLiteral _ "{?}") =+      sExp2Doc False True qual high e<|>nil+  sExpFold head cons nil e =+      sExp2Doc False True qual high e++setDoc :: (Show a, Eq a) => Bool -> (a->Doc->Doc) -> SFixity -> ArgPos -> SExp a -> Doc+setDoc qual high surFixity aPos e =+  group $ text "{" <> (addCommas $ elems e) <> text "}"+  where+  addCommas [] = nil+  addCommas [x] = sExp2Doc False True qual high x+  addCommas (x:xs) =    (sExp2Doc False True qual high x)+                     <> text ","+                     <> addCommas xs+  +  elems (SId v (Qualified "Data.FiniteMap" "EmptyFM") _) = []+  elems (SApp v [SId c (Qualified "Data.FiniteMap" "Branch") _, k, _, _, l, r])+    = k : elems l ++ elems r++fmDoc :: (Show a, Eq a) => Bool+                       -> (a->Doc->Doc)+                       -> SFixity+                       -> ArgPos+                       -> SExp a+                       -> Doc+fmDoc qual high surFixity aPos e =+  group $ text "{" <> (addCommas $ elems e) <> text "}"+  where+  addCommas [] = nil+  addCommas [(k,e)] =+        sExp2Doc False True qual high k+    <+> text "|->"+    <+> sExp2Doc False True qual high e+  addCommas ((k,e):xs) =+        sExp2Doc False True qual high k+    <+> text "|->"+    <+> sExp2Doc False True qual high e+    <>  text ","+    <>  addCommas xs+  +  elems (SId v (Qualified "Data.FiniteMap" "EmptyFM") _) = []+  elems (SApp v [SId c (Qualified "Data.FiniteMap" "Branch") _, k, e, _, l, r])+    = (k,e) : elems l ++ elems r++priority (SInfix p) = p+priority (SInfixL p) = p+priority (SInfixR p) = p+priority (SAssoc p _) = p+priority SInfixDefault = 9++isInfixL (SInfixL _) = True+isInfixL SInfixDefault = True+isInfixL _ = False++isInfixR (SInfixR _) = True+isInfixR _ = False++isNotInfixDefault SInfixDefault = False+isNotInfixDefault _ = False++considerAsOperator :: QName -> SFixity -> Bool+considerAsOperator qname fixity = isOpSym var || isNotInfixDefault fixity +  where var = case qname of Plain v -> v; Qualified _ v -> v++highlightForDepth :: Int -> [Highlight]+highlightForDepth x = [head (drop ((x `mod` (length highlights))) highlights)]+  where+    highlights :: [Highlight]+    highlights = [ Foreground Red, Foreground Green, Foreground Cyan+                 , Foreground Magenta, Foreground Yellow ]++-- A central function.  Convert an SExpression to a Document using+-- the pretty-printing combinators.  In sugar mode, lists are shown+-- with [,,,] sugar, rather than in full with cons applications.+-- Colour mode = use coloured parentheses to highlight expr depth+sExp2Doc :: (Show a, Eq a) => Bool -> Bool -> Bool -> (a->Doc->Doc) -> SExp a -> Doc+sExp2Doc colour sugar qual high = goDoc (SInfix (-1)) ARight +  where+  -- fixity of surrounding expression and which sort of argument+--goDoc :: SFixity -> ArgPos -> SExp a -> Doc+  goDoc surFixity aPos (SParens va item d) =+    if colour then+      (highlight (highlightForDepth d) (text "(")) <>+        (sExp2Doc colour sugar qual high item) <>+        (highlight (highlightForDepth d) (text ")"))+    else+      text "(" <>+      (sExp2Doc colour sugar qual high item) <>+      text ")"+  goDoc surFixity aPos (SInfinite va) =+    text "..."+  +  -- Tuples+  goDoc surFixity aPos (SApp va ((SId vt (Qualified _ (',':xs)) _):args)) =+    if length xs + 2 == length args +    then high va $+         group (text "("+                 <> foldr1 comma (map (sExp2Doc colour sugar qual high) args)+               ) <> text ")"+           -- print tuple properly+    else high va $+         optParens surFixity aPos ownFixity+         . (high vt (text ("(,"++xs++")")) <+>)+         . foldr1 (<+>) . map (goDoc ownFixity ARight) $ args+           -- partial application of tuple constructor+    where+    ownFixity = SInfix 10+    comma l r = l <|> high vt (text ",") <> r+  -- Lists+  goDoc surFixity+             aPos+             (e@(SApp va [SId vf (Qualified _ ":") ownFixity,e1,e2]))+    | sugar && not (ambiguous e2)+      = high va $ listDoc qual high surFixity aPos e+    | otherwise+      = high va $ optParens surFixity aPos ownFixity+                            (goDoc ownFixity ALeft e1+                            <> high vf (text ":")+                            <> goDoc ownFixity ARight e2)+        where -- check whether the final tail of the list is _ or {?} or {^C}.+          ambiguous :: SExp a -> Bool+          ambiguous (SApp _ [SId _ (Qualified _ ":") _, e1, e2]) = ambiguous e2+          ambiguous (SCycle _ _ e) = ambiguous e+          ambiguous (SId _ (Qualified _ "{IO}") _) = True+          ambiguous (SId _ _ _) = False+          ambiguous (SCut _)            = False+          ambiguous (SLiteral _ "{?}")  = True+          ambiguous (SUnevaluated _)    = True+          ambiguous (SInterrupted _)    = True+          ambiguous (SInfinite _)       = True+          ambiguous (SBottom _)         = True+          ambiguous _                   = True	-- shouldn't happen!+  -- Sets+  goDoc surFixity aPos ((SApp va [SId vf (Qualified "Data.Set" "MkSet") ownFixity,s]))+    = high va $ setDoc qual high surFixity aPos s+  -- Finite Maps+  goDoc surFixity aPos e@(SId va (Qualified "Data.FiniteMap" "EmptyFM") ownFixity)+    = high va $ text "{}"+  goDoc surFixity aPos e@((SApp va [SId vf (Qualified "Data.FiniteMap" "Branch") ownFixity,k,el,s,l,r]))+    = high va $ fmDoc qual high surFixity aPos e+  +  goDoc surFixity aPos (SApp va [SId vf var ownFixity,e1,e2]) +    | considerAsOperator var ownFixity = +      high va $+      optParens surFixity aPos ownFixity+        (goDoc ownFixity ALeft e1+        <+> high vf (opDoc qual var)+        <+> goDoc ownFixity ARight e2)+  goDoc surFixity aPos (SApp va [SId vf var ownFixity,e]) +    | considerAsOperator var ownFixity =+      -- show infix operator with single argument as section+      groupNest indentation . high va . parens $+        goDoc ownFixity ALeft e <-> high vf (opDoc qual var)+  goDoc surFixity aPos (SApp va (fun:args)) =+    high va+    . optParens surFixity aPos ownFixity+    . (goDoc ownFixity ALeft fun <+>)+    .  foldr1 (<+>) . map (goDoc ownFixity ARight) $ args+    where+    ownFixity = SInfix 10+  goDoc surFixity aPos (SDoStmt va m var par) =+    high va $+    bold (high m (text "do")) <+> goDoc surFixity ARight var+    <+> bold (text "<-") <+> goDoc surFixity ARight par+  goDoc _ _ (SLambda v) = high v $ text "(\\..)"+  goDoc _ _ (SId v var fixity) = high v $ funDoc qual var+  goDoc _ _ (SString v s d) = high v $ text "\"" <> text s <>+                              (if d+                               then highlight [Foreground Blue] (text "...")+                               else nil) <>+                              text "\""+  goDoc _ _ (SLiteral v lit) = high v $ text lit+  goDoc _ _ (SWithin v es) = +    high v $ foldr1 (\a b-> a <+> group (bold (text "|") <+> b))+                    (map (sExp2Doc colour sugar qual high) es)+  goDoc _ _ (SIf v exp@(SId vl (Qualified "Prelude" "False") fix) (Just res)) =+    (groupNest indentation . high v) (bold (text "if")+                                     <+> sExp2Doc colour sugar qual high exp+                                     <+> bold (text "else")+                                     <+> sExp2Doc colour sugar qual high res)+  goDoc _ _ (SIf v exp@(SId vl (Qualified "Prelude" "True") fix) (Just res)) =+    (groupNest indentation . high v) (bold (text "if")+                                     <+> sExp2Doc colour sugar qual high exp+                                     <+> bold (text "then")+                                     <+> sExp2Doc colour sugar qual high res)+  goDoc _ _ (SIf v exp Nothing) = +    (groupNest indentation . high v) (bold (text "if")+                                     <+> sExp2Doc colour sugar qual high exp)+  goDoc _ _ (SCase v exp@(SId vl (Qualified "Prelude" "False") fix)+                     (Just res@(SCase _ _ _))) =+    (groupNest indentation . high v) (bold (text "case")+                                     <+> sExp2Doc colour sugar qual high exp+                                     <+> bold (text "->")+                                     <+> sExp2Doc colour sugar qual high res)+  goDoc _ _ (SCase v exp@(SId vl (Qualified "Prelude" "False") fix)+                     (Just res)) =+    (groupNest indentation . high v) (bold (text "case")+                                     <+> sExp2Doc colour sugar qual high exp+                                     <+> bold (text "otherwise")+                                     <+> sExp2Doc colour sugar qual high res)+  goDoc _ _ (SCase v exp@(SId vl (Qualified "Prelude" "True") fix)+                     (Just res)) =+    (groupNest indentation . high v) (bold (text "case")+                                     <+> sExp2Doc colour sugar qual high exp+                                     <+> bold (text "then")+                                     <+> sExp2Doc colour sugar qual high res)+  goDoc _ _ (SCase v exp Nothing) = +    (groupNest indentation . high v) (bold (text "case")+                                     <+> sExp2Doc colour sugar qual high exp)+  goDoc _ _ (SGuard v exp@(SId vl (Qualified "Prelude" "False") fix)+                      (Just res)) =+    (groupNest indentation . high v) (bold (text "|")+                                     <+> sExp2Doc colour sugar qual high exp+                                     <+> bold (text "->")+                                     <+> sExp2Doc colour sugar qual high res)+  goDoc _ _ (SGuard v exp@(SId vl (Qualified "Prelude" "True") fix)+                      (Just res)) =+    (groupNest indentation . high v) (bold (text "|")+                                     <+> sExp2Doc colour sugar qual high exp+                                     <+> bold (text "=")+                                     <+> sExp2Doc colour sugar qual high res)+  goDoc _ _ (SGuard v exp Nothing) = +    (groupNest indentation . high v) (bold (text "|")+                                     <+> sExp2Doc colour sugar qual high exp)+  goDoc _ _ (SCut v) = high v $ highlight [ReverseVideo] (text " ")+  goDoc _ _ (SUnevaluated v) = high v $ text "_"+  goDoc _ _ (SBottom v) = high v $ text "_|_"+  goDoc _ _ (SInterrupted v) =+      highlight [Foreground Blue] $ high v $ text "{^C}"+  goDoc _ _ (SCycle v var exp) = +    groupNest indentation . high v . parens $+      text var <+> group (bold (text "where" <+> text var <+> text "=")+                          <+> sExp2Doc colour sugar qual high exp)+  goDoc _ _ (SEquation v lhs rhs) =+    group (high v (sExp2Doc colour sugar qual high lhs+                  <+> text "=" <+> sExp2Doc colour sugar qual high rhs))+  goDoc _ _ (SFieldExpr v e labs upds) =+    high v $ group (sExp2Doc colour sugar qual high e+                    <> text "{" <> commas (zipWith field labs upds)+                    <> text "}")+    where+      field name value = text name <> text "="+                         <> sExp2Doc colour sugar qual high value+      commas [] = Pretty.nil+      commas [doc] = doc+      commas (doc:docs) = doc <> text "," <+> commas docs+  goDoc _ _ (SFiniteMap v maps) =+    group (text "{" <> commas (reZipWith mapping maps) <> text "}")+    where +      mapping args res = foldr1 (<+>)+                                (map (sExp2Doc colour sugar qual high) args)+                         <> text "->"+                         <> sExp2Doc colour sugar qual high res+      commas [] = Pretty.nil+      commas [doc] = doc+      commas (doc:docs) = doc <> text "," <+> commas docs+      reZipWith f [] = []+      reZipWith f ((x,y):rs) = f x y:reZipWith f rs+  goDoc _ _ x = text (show x)+++{- Pretty-print an expression with no interior highlighting -}+prettyExpression :: String -> Int -> Options -> FileNode -> String+prettyExpression initial width+                 Options { cutoffDepth=cutoff, unevalMode=uneval+                         , stringSugar=strSugar, listSugar=listSugar+                         , showQual=qual }+                 node =+  pretty width+         (highlight [Foreground Blue] (text initial)+         <> groupNest (length initial)+                      (sExp2Doc False listSugar qual nohigh+                                (fileNode2SExp cutoff uneval+                                               strSugar False ("",node))))+  where nohigh _ doc = doc++prettySExp :: (Show a, Eq a) => String -> Int -> Options -> SExp a -> String+prettySExp initial width+           Options { cutoffDepth=cutoff, unevalMode=uneval+                   , stringSugar=strSugar, listSugar=listSugar+                   , showQual=qual, colourBracks=colouringOn}+           exp =+  pretty width+         (highlight [Foreground Blue] (text initial)+         <> groupNest (length initial)+                      (sExp2Doc colouringOn listSugar qual nohigh exp))+  where nohigh _ doc = doc++{- Pretty-print an equation with no interior highlighting -}+prettyEquation :: String -> String -> Int -> Options -> FileNode -> String+prettyEquation initial final width+               Options { cutoffDepth=cutoff, unevalMode=uneval+                       , stringSugar=strSugar, listSugar=listSugar+                       , showQual=qual }+               node =+  pretty width+         ( highlight [Foreground Blue] (text initial)+         <> groupNest (length initial)+                      ( sExp2Doc False listSugar qual nohigh+                                 (fileNode2SExp cutoff uneval strSugar True+                                                ("",node))+                        <-> text "=" <->+                        sExp2Doc False listSugar qual nohigh+                                 (fileNode2SExp cutoff uneval strSugar False+                                                ("",getResult node True)))+         <> (if null final then nil+             else delimiter "  " <> highlight [Foreground Blue] (text final)))+  where nohigh _ doc = doc++{- Pretty-print an equation with no interior highlighting -}+-- a bit of a quick hack for hat-source+-- all in one line and allows highlighting of whole equation+prettyEquation2 :: Options -> FileNode -> String+prettyEquation2 +               Options { cutoffDepth=cutoff, unevalMode=uneval+                       , stringSugar=strSugar, listSugar=listSugar+                       , showQual=qual }+               node = +  pretty 10000+           (group+                      ( sExp2Doc False listSugar qual nohigh+                                 (fileNode2SExp cutoff uneval strSugar True+                                                ("",node))+                        <-> text "=" <->+                        sExp2Doc False listSugar qual nohigh+                                 (fileNode2SExp cutoff uneval strSugar False+                                                ("",getResult node True))))+  where nohigh _ doc = doc+++{-+-- only for testing:+test1 =+  SApp (mkHatNode 0)+    [ SId (mkHatNode 1) "fun" SInfixDefault+    , SLiteral (mkHatNode 2) "24"+    , SLiteral (mkHatNode 3) "True"+    , SApp (mkHatNode 4)+        [ SId (mkHatNode 5) "+" (SInfixL 5)+        , SLiteral (mkHatNode 6) "3"+        , SLiteral (mkHatNode 7) "4"+        ]+    ]++test2 =+  SApp (mkHatNode 10)+    [ SId (mkHatNode 11) "*" (SInfixL 6)+    , SApp (mkHatNode 12)+        [ SId (mkHatNode 13) "+" (SInfixL 5)+        , SApp (mkHatNode 14)+            [ SId (mkHatNode 15) "-" (SInfixL 5)+            , SLiteral (mkHatNode 16) "3"+            , SLiteral (mkHatNode 17) "6"+            ]+        , SApp (mkHatNode 18)+            [ SId (mkHatNode 19) "-" (SInfixL 5)+            , SLiteral (mkHatNode 20) "3"+            , SLiteral (mkHatNode 21) "6"+            ]+        ]+    , test1+    ]+-}
+ tools/Slice.hs view
@@ -0,0 +1,156 @@+module Slice (Slice,union,makeSlice,sliceStartLine,sliceEndLine,sliceFile+             ,offsetSlice,highlightSlice,srcRef2Slice,RangeOrd(..)) where++import Data.Char           (isSpace)++import NodeExp        (NodeExp(..),children,getNode)+import LowLevel       (getSrcRef,nil)+import SrcRef         (SrcRef(..),readSrcRef)+import HighlightStyle (Highlight(..),Colour(..),highlight)+import Explore        (Location(..),Coord(..),getDefLocation)++import System.IO.Unsafe (unsafePerformIO)++newtype FilePos = FilePos (Int,Int) deriving Eq -- Line, Col+data PartSlice = Part {file :: FilePath+                      ,start :: FilePos+                      ,finish :: FilePos}+type Slice = [PartSlice]++instance Eq PartSlice where+  (==) (Part {file=f, start=s, finish=e}) (Part {file=f', start=s', finish=e'})+    = f == f' && s == s' && e == e'++instance Show PartSlice where+  show (Part {file=f, start=s, finish=e}) =+    "(" ++ show f ++ ":" ++ show s ++ "-" ++ show e ++ ")"++instance Show FilePos where+  show (FilePos (l,c)) = show l ++ ":" ++ show c++instance Ord FilePos where+  compare (FilePos (x, y)) (FilePos (x',y'))+    | x == x'   = compare y y'+    | otherwise = compare x x'++class Eq a => RangeOrd a where+  (<<+) :: a -> a -> Bool+  (+>>) :: a -> a -> Bool+  (+>>) x y = (<<+) y x+  (<+) :: a -> a -> Bool+  (+>) :: a -> a -> Bool+  (+>) x y = (<+) y x+  (<+>) :: a -> a -> Bool+  (>+<) :: a -> a -> Bool+  (>+<) x y = (<+>) y x++instance RangeOrd PartSlice where+  (<<+) (Part {file=f, start=s, finish=e}) (Part {file=f', start=s', finish=e'})+    | f == f'   = e <= s'+    | otherwise = f < f'+  (<+) (Part {file=f, start=s, finish=e}) (Part {file=f', start=s', finish=e'})+    = f == f' && s < s' && e > s' && e <= e'+  (<+>) (Part {file=f, start=s, finish=e}) (Part {file=f', start=s', finish=e'})+    = f == f' && s <= s' && e >= e'++union :: Slice -> Slice -> Slice+union x = compress . merge x++merge :: Slice -> Slice -> Slice+merge [] ys = ys+merge xs [] = xs+merge (x:xs) (y:ys)+  | x <<+ y || x <+ y || x <+> y = x : merge xs (y:ys)+  | otherwise                    = y : merge (x:xs) ys++compress :: Slice -> Slice+compress [] = []+compress [x] = [x]+compress (x:x1:xs)+  | x <+ x1   = compress (join x x1 : xs)+  | x <+> x1  = compress (x : xs)+  | otherwise = x : compress (x1:xs)++join :: PartSlice -> PartSlice -> PartSlice+join (Part {file=f, start=s, finish=e}) (Part {file=f', start=s', finish=e'})+  = Part {file=f, start=s, finish=e'}++makeSlice :: Int -> NodeExp -> Maybe Slice+makeSlice depth exp =+  if depth >= 1 then+    let+      parts =   map (filter (not . isZeroLoc))+              $ map (srcRef2Slice . readSrcRef)+              $ filter (/= LowLevel.nil)+              $ map (getSrcRef . getNode)+              $ (nTimes depth (concatMap children)) [exp]+      nTimes 0 _ x = x+      nTimes n f x = nTimes (n-1) f (f x) -- (new ++ acc) where new = f x +      isZeroLoc (Part {start=FilePos(0,0),finish=FilePos(0,0)}) = True+      isZeroLoc _ = False+    in+      if null parts+        then Nothing+        else Just $ foldr union (head parts) (tail parts)+  else+    let+      (f,Location{begin=Coord{row=rB,col=cB}+                 ,end=Coord{row=rE,col=cE}}) = getDefLocation $ getNode exp+    in+      Just [Part {file=f+                 ,start=FilePos(rB,cB)+                 ,finish=FilePos(rE,cE)}]++sliceStartLine :: Slice -> Int+sliceStartLine = (\(Part {start=(FilePos (s,_))}) -> s) . head++sliceEndLine :: Slice -> Int+sliceEndLine = (\(Part {finish=(FilePos (e,_))}) -> e) . last++sliceFile :: Slice -> FilePath+sliceFile = (\(Part {file=f}) -> f) . head++offsetSlice :: (Int,Int) -> Int -> Slice -> Slice+offsetSlice (l,c) so=+  map doOffset+  where+    doOffset (Part {file=f+                   ,start=(FilePos (sl,sc))+                   ,finish=(FilePos(el,ec))}) =+      Part {file=f+           ,start=FilePos(sl+l,if (sl+l) == 0 then sc + c + so else sc + c)+           ,finish=FilePos(el+l,if (el+l) == 0 then ec + c + so else ec + c)}++highlightSlice :: Slice -> String -> String+highlightSlice [] x = x+highlightSlice _ [] = []+highlightSlice ((Part {start=(FilePos (sl,sc)),finish=(FilePos (el,ec))}):others) x+  =    ls+    ++ cs+    ++ highlightedLines+    ++ rest+    where+      (ls,r) = grabLines sl x+      (cs,r1) = grabChars sc r+      (rls,r2) = grabLines (el-sl) r1+      (rcs,r3) = grabChars (if el-sl == 0 then ec-sc else ec) r2+      rest = highlightSlice (offsetSlice (-el,0) (-(ec + 2)) others) r3+      +      highlightedLines =    (unlines $ map highlightLine $ lines rls)+                         ++ highlightLine rcs+      highlightLine l =    takeWhile isSpace l+                        ++ (highlight [Background Red]+                                      $ dropWhile isSpace l)+      +      grabLines :: Int -> String -> (String,String)+      grabLines n = (\(x,y) -> (unlines x,unlines y)) . splitAt n . lines+      grabChars :: Int -> String -> (String,String)+      grabChars n = splitAt (n + 1)++srcRef2Slice :: SrcRef -> Slice+srcRef2Slice (SrcRef {filename=f+                     ,line=ls+                     ,column=cs+                     ,lineend=le+                     ,columnend=ce}) =+  [Part {file=f,start=(FilePos(ls,cs)),finish=(FilePos(le,ce))}]
+ tools/SrcRef.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE EmptyDataDecls #-}++module SrcRef+  ( SrcRef(..)+  , readSrcRef		-- :: FileNode -> SrcRef+  , defnSrcRef		-- :: Ident -> SrcRef+  ) where++import LowLevel		(FileNode(..))+import System.IO.Unsafe (unsafePerformIO)+import Foreign.Ptr      (Ptr)+import Foreign.Marshal.Alloc (free)+import Foreign.C.String	(CString, peekCString)+import Ident		(Ident(..))++-- Contents of a SrcRef node.+data SrcRef = SrcRef+  { filename	:: String+  , line	:: Int+  , column	:: Int+  , lineend	:: Int+  , columnend	:: Int+  } deriving (Eq,Show)++data SR;+foreign import ccall "artutils.h" readSRAt     :: FileNode -> IO (Ptr SR)++foreign import ccall "artutils.h" srFile       :: Ptr SR -> IO CString+foreign import ccall "artutils.h" srLine       :: Ptr SR -> IO Int+foreign import ccall "artutils.h" srColumn     :: Ptr SR -> IO Int+foreign import ccall "artutils.h" srLineEnd    :: Ptr SR -> IO Int+foreign import ccall "artutils.h" srColumnEnd  :: Ptr SR -> IO Int++readSrcRef :: FileNode -> SrcRef+readSrcRef n = unsafePerformIO $ do+    p   <- readSRAt n	-- p is malloc'ed in C land+    nm  <- srFile p+    l   <- srLine p+    c   <- srColumn p+    le  <- srLineEnd p+    ce  <- srColumnEnd p+    snm <- peekCString nm+    free p		-- dispose of p again+    return SrcRef+	{ filename  = snm+	, line      = l+	, column    = c+	, lineend   = le+	, columnend = ce+	}++---------------------------------------------------------------------+defnSrcRef :: Ident -> SrcRef+defnSrcRef i = SrcRef+	{ filename	= i_srcfile i+	, line		= i_defnline i+	, column	= i_defncol i+	, lineend	= i_defnlineend i+	, columnend	= i_defncolend i+	}
+ tools/SrcRefViewer.hs view
@@ -0,0 +1,96 @@+-- Simple program to display a src reference.+-- Reports the filename and location, and shows a section of the file+-- with the cursor on the actual location.  We try to place the+-- important line as near the centre of the screen as possible.++module Main where++import System.Environment (getProgName, getArgs)+import System.Cmd     (system)+import System.Exit    (exitWith, ExitCode(..))+import System.IO      (hSetBuffering,BufferMode(..),stdin,stdout)+import Data.Char      (isSpace,isDigit)+import Run            (runAndReadStdout)+import HighlightStyle (getTerminalSize,cls,goto,highlight,lineWrap+                      ,Highlight(..),Colour(..))++main = do+    args <- System.Environment.getArgs+    case args of+      [filename,sline,scol] ->+              let line = (read sline)::Int+                  column = (read scol)::Int in+              display filename line column 0 0+      [filename,sline,scol,sline2,scol2] ->+              let line = (read sline)::Int+                  column = (read scol)::Int+                  endline = (read sline2)::Int+                  endcolumn = (read scol2)::Int in+              display filename line column endline endcolumn+      _ -> do prog <- System.Environment.getProgName+              putStrLn ("Usage: "++prog++" srcfile line col [endline endcol]")+              exitWith (ExitFailure 1)++display :: FilePath -> Int -> Int -> Int -> Int -> IO ()+display srcfile line column endline endcolumn = do+    len <- runAndReadStdout ("wc -l "++srcfile)+    let n = read (takeWhile isDigit (dropWhile isSpace len))+    case n of+      0 -> do putStrLn ("File "++srcfile++" not found.")+              exitWith (ExitFailure 1)+      _ -> do (width,height) <- getTerminalSize+              f <- readFile srcfile+              hSetBuffering stdin NoBuffering+              hSetBuffering stdout NoBuffering+              let middle= (height `div` 2) - 1+                  trim  = if line < middle then 0 else line - middle+                  fs    = (expandTabs . unlines . take (height-2)+                          . drop trim . lines) f+                  line' = line-trim+                  (a,b,c) = split (line',column,endline-trim,endcolumn) fs+              putStr (cls ++ goto 1 1 ++ lineWrap False)+              putStr (highlight [Bold] ("---- "++srcfile++" ---- line: "+                                       ++show line++" ---- column: "+                                       ++show column++" ----"))+              if endline==0+                then putStr (goto 1 2 ++ fs ++ goto column (line'+1))+                else putStr (goto 1 2 ++ a+                             ++ highlight [Bold, Foreground Magenta] b ++ c+                             ++ goto column (line'+1))+              System.Cmd.system ("stty -icanon min 1 -echo")+              awaitQuit+              System.Cmd.system ("stty icanon echo")+              putStr (goto 1 height)+              return ()++split :: (Int,Int,Int,Int) -> String -> (String,String,String)+split (sl,sc,el,ec) str+  | sl==el    =+    let (a,b) = splitAt (el-1) (lines str)+        (c,d) = splitAt ec (head b)+        (e,f) = splitAt (sc-1) c+    in (unlines a++e, f, unlines (d:tail b))+  | otherwise =+    let ls = lines str+        (a,b)   = splitAt (el-1) (lines str)+        (a',b') = splitAt  ec    (head b)+        (p,q)   = splitAt (sl-1) a+        (p',q') = splitAt (sc-1) (head q)+    in (unlines p++p', unlines (q':tail q)++a', unlines (b':tail b))++awaitQuit :: IO ()+awaitQuit = do+  q <- getChar+  case q of+    'q' -> return ()+    'x' -> return ()+    _   -> awaitQuit++expandTabs :: String -> String+expandTabs = expand 0+  where expand n []         = []+        expand n ('\n':xs)  = '\n': expand 0 xs+        expand 8 ('\t':xs)  = replicate 8     ' ' ++ expand 0 xs+        expand n ('\t':xs)  = replicate (8-n) ' ' ++ expand 0 xs+        expand 8 (x:xs)     = x : expand 1 xs+        expand n (x:xs)     = x : expand (n+1) xs
+ tools/TExp.hs view
@@ -0,0 +1,54 @@+module TExp+  ( TExp+  , linearise+  ) where++import SExp++-- The TExp datatype is a tokenisation of the SExp type+data TExp+  = TApp+  | TId QName+  | TLiteral String+  | TString String+  | TWithin+  | TLambda+  | TIf+  | TCase+  | TGuard+  | TCut+  | TUnevaluated+  | TInterrupted+  | TBottom+  | TCycle+  | TEquation+  | TFieldExpr+-- ...with added bracketing to disambiguate arguments+  | TOpen+  | TClose+  | TRHS+  deriving Eq++-- linearise converts the SExp tree to a stream of tokens, by+-- pre-order traversal+linearise :: SExp a -> [TExp]+linearise (SEquation x lhs rhs) = TEquation: linearise lhs+					++ TRHS: linearise rhs+linearise (SApp _ es)      = TOpen: TApp: concatMap linearise es ++ [TClose]+linearise (SId _ s _)      = [TId s]+linearise (SLiteral _ s)   = [TLiteral s]+linearise (SString _ s _)  = [TString s]+linearise (SWithin _ es)   = TOpen: TWithin: concatMap linearise es ++ [TClose]+linearise (SLambda _)      = [TLambda]+linearise (SIf _ e _)      = TIf: linearise e+linearise (SCase _ e _)    = TCase: linearise e+linearise (SGuard _ e _)   = TGuard: linearise e+linearise (SCut _)         = [TCut]+linearise (SUnevaluated _) = [TUnevaluated]+linearise (SInterrupted _) = [TInterrupted]+linearise (SBottom _)      = [TBottom]+linearise (SDoStmt _ _ e p)= TOpen: TApp: TLambda: linearise e ++ [TClose]+linearise (SCycle _ _ e)   = TCycle: linearise e+linearise (SFieldExpr _ e fs vs) = TOpen: TFieldExpr: linearise e+                                   ++ concatMap linearise vs ++ [TClose]+
+ tools/Trie.hs view
@@ -0,0 +1,90 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Trie+-- Copyright   :  (c) Malcolm Wallace 2002+-- License     :  Hat (or GPL, if used outside Hat)+-- +-- Maintainer  :  Malcolm.Wallace@cs.york.ac.uk+-- Stability   :  stable+-- Portability :  portable+--+--  A simple searchable Trie.+--+-----------------------------------------------------------------------------+module Trie+  ( Trie		-- type exported abstract+  , emptyTrie		-- :: Trie a+  , Search(..)		-- data Search a = Exists | New a+  , match		-- :: [a] -> Trie a -> Search (Trie a)+  ) where++-- | A Trie is a lookup structure for strings of tokens.+-- * Any path through the Trie that terminates in a Found constructor+--   indicates that the string represented by that path is stored.+-- * A path that goes through a FoundAnd constructor indicates that+--   the prefix (up to FoundAnd) is definitely stored, and possibly+--   its continuation also.+-- * Any path or partial path that does not end with either a Found+--   or FoundAnd, means that the corresponding string is not stored.++data Trie a = Trie [(a,Trie a)] | Found | FoundAnd [(a,Trie a)]+		deriving Show+data Search a = Exists | New {fromNew::a}+		deriving Show++emptyTrie :: Trie a+emptyTrie  = Trie []++-- | `match' takes a string and a trie and tries to find the string in the trie.+--   If the string is present in the Trie, we return Exists, if not, we return+--   a New trie with the string added to it.+match :: Eq a => [a] -> Trie a -> Search (Trie a)++match [t]    (Trie xs) =+  case lookup t xs of+    Nothing           -> New (Trie ((t,Found):xs))+    Just Found        -> Exists+    Just (FoundAnd _) -> Exists+    Just (Trie ys)    -> New (Trie (replace (t,FoundAnd ys) xs))++match (t:ts) (Trie xs) =+  case lookup t xs of+    Nothing    -> New (Trie ((t, ripple ts):xs))+    Just Found -> New (Trie (replace (t, foundAnd (ripple ts)) xs))+    Just y     -> case match ts y of+                      Exists -> Exists+                      New tr -> New (Trie (replace (t, tr) xs))++match [t]    (FoundAnd xs) =+  case lookup t xs of+    Nothing           -> New (FoundAnd ((t,Found):xs))+    Just Found        -> Exists+    Just (FoundAnd _) -> Exists+    Just (Trie ys)    -> New (FoundAnd (replace (t,FoundAnd ys) xs))++match (t:ts) (FoundAnd xs) =+  case lookup t xs of+    Nothing    -> New (FoundAnd ((t,ripple ts):xs))+    Just Found -> New (FoundAnd (replace (t, foundAnd (ripple ts)) xs))+    Just y     -> case match ts y of+                      Exists -> Exists+                      New tr -> New (FoundAnd (replace (t, tr) xs))+++---------------------------------------------------------------------------+-- In the Trie, when a new path is inserted, it replaces the old one.+replace :: Eq a => (a,b) -> [(a,b)] -> [(a,b)]+replace (x,y) ((a,b):abs) | x==a      = (x,y): abs+                          | otherwise = (a,b): replace (x,y) abs++-- To build a single path from an empty Trie, we just ripple the string of+-- tokens down.+ripple :: [a] -> Trie a+ripple []     = Found+ripple (x:xs) = Trie [(x,ripple xs)]++-- Convert a Trie to a FoundAnd.+foundAnd :: Trie a -> Trie a+foundAnd (Trie xs) = FoundAnd xs++---------------------------------------------------------------------------
+ tools/animnode.h view
@@ -0,0 +1,74 @@+/*+ *  anim-node.h+ *  + *+ *  Created by Thomas Davie on Fri Nov 21 2003.+ *  Copyright (c) 2003 Thomas Davie. All rights reserved.+ *+ */++#include <stdio.h>++#ifndef _ANIM_NODE+#define _ANIM_NODE++typedef struct position_s+{+    unsigned int line;+    unsigned int column;+} position;++typedef enum +{+    infix = 0,+    infixl,+    infixr,+    defaultFix+} fixity;++typedef struct fixPri_s+{+    fixity fix;+    int something;+} fixPri;++typedef struct node_s+{+    int nodeType;+    unsigned long offset;+    +    union+    {+        struct {char *value;} atomAbstract;+        struct {unsigned long module; position filePos; fixPri fix; int arity; char *name; char hasFields; unsigned long *args;} atomConstructor;+        struct {unsigned long module; position filePos; fixPri fix; int arity; char *name; char local;} atomVariable;+        struct {char hasUse; unsigned long use; unsigned long parent; unsigned long result; unsigned long function; int arity; unsigned long *args;} expApp;+        struct {char hasUse; unsigned long use; unsigned long parent; unsigned long result; unsigned long condition;} expCase;+        struct {char hasUse; unsigned long use; unsigned long parent; char value;} expChar;+        struct {unsigned long parent; unsigned long result; unsigned long var;} expConstDef;+        struct {char hasUse; unsigned long use; unsigned long parent; unsigned long value;} expConstUse;+        struct {char hasUse; unsigned long use; unsigned long statement;} expDoStmt;+        struct {char hasUse; unsigned long use; unsigned long parent; double value;} expDouble;+        struct {char hasUse; unsigned long use; unsigned long parent; unsigned long result; unsigned long arg; int arity; unsigned long *binders; unsigned long *bindees;} expFieldUpdate;+        struct {char hasUse; unsigned long use; unsigned long parent; float value;} expFloat;+        struct {unsigned long result;} expForward;+        struct {char hasUse; unsigned long use; unsigned long parent; unsigned long result; unsigned long condition;} expGuard;+        struct {unsigned long parent; unsigned long result;} expHidden;+        struct {char hasUse; unsigned long use; unsigned long parent; unsigned long result; unsigned long condition;} expIf;+        struct {char hasUse; unsigned long use; unsigned long parent; unsigned long value;} expInt;+        struct {char hasUse; unsigned long use; unsigned long parent; char *value;} expInteger;+        struct {char hasUse; unsigned long use; unsigned long parent; unsigned long exp;} expProjection;+        struct {char hasUse; unsigned long use; unsigned long parent; unsigned long numerator; unsigned long denominator;} expRat;+        struct {char hasUse; unsigned long use; unsigned long parent; char *numerator; char *denominator;} expRational;+        struct {char hasUse; unsigned long use; unsigned long parent; unsigned long function; int arity; unsigned long *args;} expValueApp;+        struct {char hasUse; char isLambda; unsigned long use; unsigned long parent; unsigned long value;} expValueUse;+        struct {char wasTraced; char *name; char *filename;} module;+        struct {unsigned long module; position filePos;} srcPos;+    } params;+} node;++typedef unsigned long fourbytes;++node* readNode (FILE *hatFile, unsigned long offset);++#endif
+ tools/artutils.c view
@@ -0,0 +1,1845 @@+#include <unistd.h>+#include <stdlib.h>+#include <stdio.h>+#include <string.h>+#include <errno.h>+#include <sys/stat.h>+#include <signal.h>+#include <assert.h>+#include "art.h"+#include "artutils.h"+#include "pathutils.h"+#include "ntohl.h"++#define DEBUG 0++#if DEBUG+#define HIDE(x)	x+#else+#define HIDE(x)+#endif++#define MAX_STRING 0xff+#define MAX_BIG_STRING 0xffff++/* We open the .hat file *twice* with different handles, for efficiency.+ *+ * For random access, use the global HatFileRandom handle.  Most operations+ * assume this mode of access.+ *+ * For sequential access, use the global HatFileSeq handle: the+ * operation variants prefixed with q_ keep a global record (q_position)+ * of the current file position, which is much cheaper than doing ftell().+ */+FileOffset errorRoot, errorMsg, remoteStartNode=0;+FileOffset q_position;+FILE	*HatFileRandom, *HatFileSeq, *OutputFile, *BridgeFile;+unsigned filesize=0, outputsize=0;+char	*progname;		/* name of browser, not of the subject */+Bool	interrupt=False;	/* ^C interrupt at program runtime */+Bool	hat_interrupted=False;	/* ^C interrupt in browsing tool */++FileOffset+currentfilepos (void) { return q_position; }+++void+finalise (void)+{+  fclose(HatFileRandom);+  fclose(HatFileSeq);+  fclose(OutputFile);+  fclose(BridgeFile);+}++++/* Open a file for reading, given:+ *    the base name of the file+ *    the file extension+ */+FILE*+openFile (char* base, char* ext)+{+  char filename[MAX_STRING];+  FILE* file;+  strcpy(filename,base);+  strcat(filename,ext);+  if (file = fopen(filename,"rb")) {+    return file;+  } else {+    fprintf(stderr,"%s: cannot open %s\n",progname,filename);+    exit(1);+  }+}++/* Determine the size of a file, given:+ *    the base name of the file+ *    the file extension+ */+int+sizeFile (char* base, char* ext)+{+  char filename[MAX_STRING];+  struct stat buf;+  strcpy(filename,base);+  strcat(filename,ext);+  stat(filename,&buf);+  return buf.st_size;+}+++/* freadAt() is just like fread(), except it seeks to a specific+ * file location first.  (Random Access)+ */+int+freadAt (FileOffset fo, void* ptr, int size, int nmemb, FILE* stream)+{+  int err;+  if (fo < 0x10) {+    fprintf(stderr,"%s: attempt to read inside .hat header\n",progname);+    fprintf(stderr,"%s: offset = 0x%x\n",progname,fo);+    exit(1);+  } else if (fo > filesize) {+    fprintf(stderr,"%s: attempt to read beyond end of file\n",progname);+    fprintf(stderr,"%s: offset = 0x%x, filesize = 0x%x\n",progname,fo,filesize);+    fprintf(stderr,"%s: errno = %d (%s)\n",progname,errno,strerror(errno));+    exit(1);+  }+  if (fseek(stream, fo, SEEK_SET)) {+    fprintf(stderr,"%s: seek error on file\n",progname);+    fprintf(stderr,"%s: errno = %d (%s)\n",progname,errno,strerror(errno));+    exit(1);+  }+  err = fread(ptr,size,nmemb,stream);+  return err;+}++/* q_fread() is just like fread() except it advances the global counter+ * recording the file position.  (Sequential Access)+ */+int+q_fread(void* buf, int siz, int num, FILE* file)+{+  int err;+  err = fread(buf,siz,num,file);+  q_position += err*siz;+//if (err<num) {+//  fprintf(stderr,"q_fread: warning, only read %d of %d values (size %d)\n"+//                ,err,num,siz);+//}+  return err;+}++++/* readFO() reads a single FileOffset from the file and ensures it is+ * in host-endian order.  (Random Access)+ */+FileOffset+readFO (void)+{+  FileOffset fo;+  fread(&fo,sizeof(FileOffset),1,HatFileRandom);+  HIDE(fprintf(stderr,"readFO -> 0x%x\n",ntohl(fo));)+  return ntohl(fo);+}+/* (Sequential Access) */+FileOffset+q_readFO (void)+{+  FileOffset fo;+  q_fread(&fo,sizeof(FileOffset),1,HatFileSeq);+  HIDE(fprintf(stderr,"q_readFO -> 0x%x\n",ntohl(fo));)+  return ntohl(fo);+}++++/* readString() reads a length-annotated string from the current position+ * in the file.  (Random Access)+ */+char*+readString (void)+{+  char *buf;+  int i, n;++  n = (int)fgetc(HatFileRandom);+  if (n==MAX_STRING) {+    n = (int)fgetc(HatFileRandom);+    n = (n<<8) + (int)fgetc(HatFileRandom);+  }+  buf = (char*)malloc((n+1)*sizeof(char));+  i = fread(buf,sizeof(char),n,HatFileRandom);+  buf[n] = '\0';+  if (i<n) {+    fprintf(stderr,"%s: warning, only read %d characters of %d in string"+                  ,progname,i,n);+  }+  HIDE(fprintf(stderr,"readString -> %s\n",buf);)+  return buf;+}+/* (Sequential Access) */+char*+q_readString (void)+{+  char *buf;+  int i, n;++  n = (int)fgetc(HatFileSeq);+  q_position += 1;+  if (n==MAX_STRING) {+    n = (int)fgetc(HatFileSeq);+    n = (n<<8) + (int)fgetc(HatFileSeq);+    q_position += 2;+  }+  buf = (char*)malloc((n+1)*sizeof(char));+  i = q_fread(buf,sizeof(char),n,HatFileSeq);+  buf[n] = '\0';+  if (i<n) {+    fprintf(stderr,"%s: warning, only read %d characters of %d in string"+                  ,progname,i,n);+  }+  HIDE(fprintf(stderr,"q_readString -> %s\n",buf);)+  return buf;+}+++/* q_peek() takes a sneaky look at the next byte of the file, to+ * determine whether we want to go ahead and read it now.+ */+char+q_peek (void)+{+  char c;+  c = (char)fgetc(HatFileSeq);+  ungetc(c,HatFileSeq);+  return c;+}+++++/* readModuleAt() fills in the name of the module and its source file,+ * given the location of the module descriptor in the file.+ */+void+readModuleAt (FileOffset fo, char** modname, char** srcname, Bool* traced)+{+  char c;++  HIDE(fprintf(stderr,"readModuleAt 0x%x\n",fo);)+  freadAt(fo,&c,sizeof(char),1,HatFileRandom);+  if (lower5(c)!=Module) {+    fprintf(stderr,"%s: expected a Module descriptor at position 0x%x\n"+                  ,progname,fo);+    exit(1);+  }+  *traced  = tracedModule(c);+  *modname = readString();+  *srcname = readString();+  HIDE(fprintf(stderr,"readModuleAt 0x%x -> %s %s\n",fo,*modname,*srcname);)+}+++/* readAtomAt() fills in the name of the variable or constructor,+ * as well as its module, source file, fixity, and definition position,+ * given the location of the Atom descriptor in the file.+ */+Ident*+readAtomAt (FileOffset fo)+{+  char c;+  FileOffset modpos;+  Ident* id=0;+  int defnpos;+  int defnposend;++  if (fo==Lambda) {+    id = (Ident*)malloc(sizeof(Ident));+    id->idname   = "(\\..)";+    id->modname  = id->srcname = "";+    id->fixity   = noFixity;+    id->defnline = id->defncolumn = 0;+    id->defnlineend = id->defncolumnend = 0;+    id->isTraced = False;+    id->atomtype = Abstract;+  } else if (fo==DoLambda) {+    id = (Ident*)malloc(sizeof(Ident));+    id->idname   = "do";+    id->modname  = id->srcname = "";+    id->fixity   = noFixity;+    id->defnline = id->defncolumn = 0;+    id->defnlineend = id->defncolumnend = 0;+    id->isTraced = False;+    id->atomtype = Abstract;+  } else {+    HIDE(fprintf(stderr,"readAtomAt 0x%x\n",fo);)+    freadAt(fo,&c,sizeof(char),1,HatFileRandom);+    switch (lower5(c)) {+      case AtomVariable:+      case AtomConstructor:+          id = (Ident*)malloc(sizeof(Ident));+          modpos = readFO();+          fread(&defnpos,sizeof(int),1,HatFileRandom);+          fread(&defnposend,sizeof(int),1,HatFileRandom);+          fread(&(id->fixity),sizeof(char),1,HatFileRandom);+          fread(&(id->arity),sizeof(char),1,HatFileRandom);+          id->idname       = readString();+          id->defnline     = ntohl(defnpos)/10000;+          id->defncolumn   = ntohl(defnpos)%10000;+          id->defnlineend  = ntohl(defnposend)/10000;+          id->defncolumnend= ntohl(defnposend)%10000;+          if (lower5(c)==AtomVariable) {+              id->atomtype = Variable;+          } else if (hasFields(c)) {+              id->atomtype = ConstrFields;+          } else {+              id->atomtype = Constructor;+          }+          readModuleAt(modpos,&(id->modname),&(id->srcname),&(id->isTraced));+          break;+      case AtomAbstract: {+          char *tmp;+          id = (Ident*)malloc(sizeof(Ident));+          id->idname   = readString();+          id->modname  = id->srcname = "";+          id->fixity   = noFixity;+          id->defnline = id->defncolumn = id->defnlineend = +            id->defncolumnend = 0;+          id->isTraced = False;+          id->atomtype = Abstract;+          tmp = (char*)malloc(strlen(id->idname)+3);+          strcpy(tmp,"{"); strcat(tmp,id->idname); strcat(tmp,"}");+          free(id->idname); id->idname=tmp;+          } break;+      default:+          fprintf(stderr,"%s: expected an Atom descriptor at position 0x%x\n"+                        ,progname,fo);+          exit(1);+          break;+    }+  }+  HIDE(fprintf(stderr,"readAtomAt 0x%x -> %s %s %s %d %d %d %d %d\n",fo,id->idname,id->modname,id->srcname,id->defnline,id->defncolumn,id->defnlineend,id->defncolumnend,id->fixity);)+  return id;+}++++/* readSRAt() fills in a struct containing the filename and usage+ * position of a source reference, given the location of the+ * SrcPos descriptor in the file.+ */+SrcRef *+readSRAt (FileOffset fo)+{+  FileOffset modpos;+  char *modname, *srcname;+  int usepos;+  int useposend;+  char c;+  Bool dummy;+  SrcRef *sr;++  HIDE(fprintf(stderr,"readSRAt 0x%x\n",fo);)+  if (fo) {+    freadAt(fo,&c,sizeof(char),1,HatFileRandom);+    if (lower5(c)!=SrcPos) {+      fprintf(stderr,"%s: expected a SrcPos descriptor at position 0x%x\n"+                    ,progname,fo);+      fprintf(stderr,"%s: got a 0x%x\n",progname,c);+      exit(1);+    }+    sr = (SrcRef*)malloc(sizeof(SrcRef));+    modpos = readFO();+    fread(&usepos,sizeof(int),1,HatFileRandom);+    usepos = ntohl(usepos);+    fread(&useposend,sizeof(int),1,HatFileRandom);+    useposend = ntohl(useposend);+    readModuleAt(modpos, &modname, &(sr->srcname), &dummy);+    sr->line    = usepos/10000;+    sr->column  = usepos%10000;+    sr->lineend = useposend/10000;+    sr->columnend = useposend%10000;+    return sr;+  } else {+    return (SrcRef*)0;+  }+}++char*+srFile (SrcRef* sr)      { return sr->srcname; }+int+srLine (SrcRef* sr)      { return sr->line; }+int+srColumn (SrcRef* sr)    { return sr->column; }+int+srLineEnd (SrcRef* sr)   { return sr->lineend; }+int+srColumnEnd (SrcRef* sr) { return sr->columnend; }+++/* readValueAt() returns a struct containing a readable notation of the+ * value-Exp stored at the given location in the file.+ */+Ident*+readValueAt (FileOffset fo)+{+  char c, buf[MAX_STRING];  +  Ident *id = (Ident*)malloc(sizeof(Ident));+  FileOffset parent, usepos = 0;++  /* defaults */+  id->idname   = (char*)0;+  id->modname  = (char*)0;+  id->srcname  = (char*)0;+  id->fixity   = noFixity;+  id->arity    = 0;+  id->defnline      = 0;+  id->defncolumn    = 0;+  id->defnlineend   = 0;+  id->defncolumnend = 0;+  id->isTraced   = False;+  id->atomtype   = Literal;++  HIDE(fprintf(stderr,"readValueAt 0x%x\n",fo);)+  freadAt(fo,&c,sizeof(char),1,HatFileRandom);+  if ((lower5(c)<ExpChar) || (lower5(c)>ExpConstDef)) {+    fprintf(stderr,"%s: expected a value Exp descriptor at position 0x%x\n"+                  ,progname,fo);+    exit(1);+  }+  HIDE(fprintf(stderr,"readValueAt 0x%x -> tag 0x%x\n",fo,c);)+  if (hasSrcPos(c)) { usepos = readFO(); }+  parent = readFO();+  switch (lower5(c)) {+    case ExpChar:+		{ fread(&c,sizeof(char),1,HatFileRandom);+		  if ((c>31) && (c!='\''))+		    sprintf(buf,"'%c'",c);+		  else switch(c) {+		    case '\n': sprintf(buf,"'\\n'"); break;+		    case '\t': sprintf(buf,"'\\t'"); break;+		    case '\255' : sprintf(buf,"'\\e'"); break;+		    default  : sprintf(buf,"'\\0%X'",c); break;+		  }+		  id->idname = strdup(buf);+		} break;+    case ExpInt:+		{ int i;+		  fread(&i,sizeof(int),1,HatFileRandom);+		  sprintf(buf,"%d",ntohl(i));+		  id->idname = strdup(buf);+		} break;+    case ExpInteger:+		{ id->idname = readString();+		} break;+    case ExpRat:+		{ int i,j;+		  fread(&i,sizeof(int),1,HatFileRandom);+		  fread(&j,sizeof(int),1,HatFileRandom);+		  sprintf(buf,"%d%%%d",ntohl(i),ntohl(j));+		  id->idname = strdup(buf);+		} break;+    case ExpRational:+		{ sprintf(buf,"%s%%%s",readString(), readString());+		  id->idname = strdup(buf);+		} break;+    case ExpFloat:+		{ float f;+		  fread(&f,sizeof(float),1,HatFileRandom);+		  sprintf(buf,"%.6f",f);+		  id->idname = strdup(buf);+		} break;+    case ExpDouble:+		{ double d;+		  fread(&d,sizeof(double),1,HatFileRandom);+		  sprintf(buf,"%.15f",d);+		  id->idname = strdup(buf);+		} break;+    case ExpValueApp:+    case ExpValueUse:+		{ FileOffset atom;+                  free(id);+                  atom = readFO();+		  id = readAtomAt(atom);+		} break;+    case ExpConstUse:+		{ FileOffset def;+                  free(id);+                  def = readFO();+		  id = readValueAt(def);+		} break;+    case ExpConstDef:+		{ FileOffset atom;+                  free(id);+                  readFO();	/* skip result (? should we follow it ?) */+                  atom = readFO();+		  id = readAtomAt(atom);+		} break;+    default: break;+  }+  HIDE(fprintf(stderr,"readValueAt 0x%x -> %s %s %s %d %d %d\n",fo,id->idname,id->modname,id->srcname,id->defnline,id->defncolumn,id->fixity);)+  if (!id->idname) id->idname = strdup("Problem");+  return id;+}++/* Skip a complete node in the file, given that the tag byte has already+ * been read. (Sequential Access)  Returns the parent pointer of the node,+ * if it has one, although in many cases this is ignored.+ */+FileOffset+q_skipNode (char tag)+{+  FileOffset parent=0;+  switch (lower5(tag)) {+    case Module:+        q_readString(); q_readString();+        break;+    case SrcPos:+        q_readFO();+        { int x; q_fread(&x,sizeof(int),1,HatFileSeq); }+        { int x; q_fread(&x,sizeof(int),1,HatFileSeq); }+        break;+    case ExpApp:+        if (hasSrcPos(tag)) q_readFO();+        parent = q_readFO(); q_readFO(); q_readFO();+        { char arity; q_fread(&arity,sizeof(char),1,HatFileSeq);+          while (arity--) { q_readFO(); } }+        break;+    case ExpValueApp:+        if (hasSrcPos(tag)) q_readFO();+        parent = q_readFO(); q_readFO();+        { char arity; q_fread(&arity,sizeof(char),1,HatFileSeq);+          while (arity--) { q_readFO(); } }+        break;+    case ExpChar:+        if (hasSrcPos(tag)) q_readFO();+        parent = q_readFO();+        { char x; q_fread(&x,sizeof(char),1,HatFileSeq); }+        break;+    case ExpInt:+        if (hasSrcPos(tag)) q_readFO();+        parent = q_readFO();+        { int x; q_fread(&x,sizeof(int),1,HatFileSeq); }+        break;+    case ExpInteger:+        if (hasSrcPos(tag)) q_readFO();+        parent = q_readFO();+        q_readString();+        break;+    case ExpRat:+        if (hasSrcPos(tag)) q_readFO();+        parent = q_readFO();+        { int x[2]; q_fread(&x[0],sizeof(int),2,HatFileSeq); }+        break;+    case ExpRational:+        if (hasSrcPos(tag)) q_readFO();+        parent = q_readFO();+        q_readString(); q_readString();+        break;+    case ExpFloat:+        if (hasSrcPos(tag)) q_readFO();+        parent = q_readFO();+        { float x; q_fread(&x,sizeof(float),1,HatFileSeq); }+        break;+    case ExpDouble:+        if (hasSrcPos(tag)) q_readFO();+        parent = q_readFO();+        { double x; q_fread(&x,sizeof(double),1,HatFileSeq); }+        break;+    case ExpValueUse:+    case ExpConstUse:+    case ExpProjection:+        if (hasSrcPos(tag)) q_readFO();+        parent = q_readFO(); q_readFO();+        break;+    case ExpConstDef:+        parent = q_readFO(); q_readFO(); q_readFO();+        break;+    case ExpGuard:+    case ExpCase:+    case ExpIf:+        if (hasSrcPos(tag)) q_readFO();+        parent = q_readFO(); q_readFO(); q_readFO();+        break;+    case ExpFieldUpdate:+        if (hasSrcPos(tag)) q_readFO();+        parent = q_readFO(); q_readFO(); q_readFO();+        { char arity; q_fread(&arity,sizeof(char),1,HatFileSeq);+          arity = 2*arity;+          while (arity--) { q_readFO(); } }+        break;+    case ExpHidden:+        parent = q_readFO(); q_readFO(); q_readFO();+        break;+    case ExpForward:+        parent = q_readFO();	/* note different to value of parentNode() */+        break;+    case ExpDoStmt:+        if (hasSrcPos(tag)) q_readFO();+        parent = q_readFO();	/* note different to value of parentNode() */+        break;+    case AtomVariable:+        q_readFO();+        { int x; q_fread(&x,sizeof(int),1,HatFileSeq); }+        { int x; q_fread(&x,sizeof(int),1,HatFileSeq); }+        { char x; q_fread(&x,sizeof(char),1,HatFileSeq); }+        { char x; q_fread(&x,sizeof(char),1,HatFileSeq); }+        q_readString();+        break;+    case AtomConstructor:+        q_readFO();+        { int x; q_fread(&x,sizeof(int),1,HatFileSeq); }+        { int x; q_fread(&x,sizeof(int),1,HatFileSeq); }+        { char x; q_fread(&x,sizeof(char),1,HatFileSeq); }+        { char arity; q_fread(&arity,sizeof(char),1,HatFileSeq);+          q_readString();+          if (hasFields(tag)) while (arity--) q_readFO(); }+        break;+    case AtomAbstract:+        q_readString();+        break;+    case ListCons:+        q_readFO();+        q_readFO();+    default: break;+  }+  return parent;+}+++/* readTraceAt() fills in a string containing a readable notation of the+ * Trace stored at the given location in the file.  It returns the+ * parent trace.  This routine is only currently used by the "virtual+ * stack trace" program.+ */+FileOffset+readTraceAt (FileOffset fo, char** expr, SrcRef** sr, int* infix+            ,int followHidden, int depth)+{+  char c, buf[10000];  /* fixed size no final solution */+  FileOffset parent;++  *infix = (int)noFixity;	/* default */++  if (depth <= 0) {+    *expr = strdup("[7m [0m");+    return fo;+  }++  if (fo<=DoLambda) {+    switch (fo) {+      case Root:        sprintf(buf,"<Root>"); break;+      case Unevaluated: sprintf(buf,"_"); break;+      case Entered:     sprintf(buf,"_|_"); break;+      case Interrupted: sprintf(buf,"{^C}"); break;+      case Lambda:      sprintf(buf,"(\\..)"); break;+      case DoLambda:    sprintf(buf,"do"); break;+    }+    *expr = strdup(buf);+    *infix = noFixity;+    *sr = 0;+    return fo;+  } else {+    HIDE(fprintf(stderr,"readTraceAt 0x%x\n",fo);)+    freadAt(fo,&c,sizeof(char),1,HatFileRandom);+    if ((lower5(c)<ExpApp) || (lower5(c)>ExpDoStmt)) {+      fprintf(stderr,"%s: expected Exp descriptor at position 0x%x (got 0x%x)\n"+                    ,progname,fo,c);+      exit(1);+    }+    HIDE(fprintf(stderr,"readTraceAt 0x%x -> tag 0x%x\n",fo,c);)+    switch (lower5(c)) {+      case ExpApp:+	{ unsigned char i, arity;+	  FileOffset foExprs[20], foSR=0;+	  char* exprs[20];+	  int  fixexp[20];+          if (hasSrcPos(c)) { foSR = readFO(); }+          parent = readFO();			/* get parent */+          HIDE(fprintf(stderr,"enter parent of 0x%x -> 0x%x\n",fo,parent);)+          readFO();				/* skip result */+	  foExprs[0] = readFO();		/* get fun */+	  fread(&arity,sizeof(unsigned char),1,HatFileRandom);+	  for (i=1; i<=arity; i++) {+	    foExprs[i] = readFO();+          }+	  for (i=0; i<=arity; i++) {+	    (void)readTraceAt(getResult(foExprs[i],True)+                             ,&(exprs[i]),sr,&(fixexp[i]),False,depth-1);+          }+	  *infix = fixexp[0];+	  if (isInfix(fixexp[0]) && c >= 2) {+	    sprintf(buf,"%s",infixPrint(exprs[1],fixexp[1],exprs[0],fixexp[0]+			    ,exprs[2],fixexp[2]));+	    for (i=3; i<=arity; i++) {+	      strcat(buf," ");+	      strcat(buf,exprs[i]);+            }+	  } else {	/* no fixity */+	    sprintf(buf,"(%s",exprs[0]);+	    for (i=1; i<=arity; i++) {+	      strcat(buf," ");+	      if (isInfix(fixexp[i])) {+	        strcat(buf,"(");+	        strcat(buf,exprs[i]);+	        strcat(buf,")");+	      } else+	        strcat(buf,exprs[i]);+            }+	    strcat(buf,")");+	  }+	  *expr = strdup(buf);+          *sr   = readSRAt(foSR);+          HIDE(fprintf(stderr,"return parent of 0x%x -> 0x%x\n",fo,parent);)+	  return parent;+	} break;+      case ExpValueApp:+	{ unsigned char i, arity; Ident* id;+	  FileOffset foExprs[20], foSR=0;+	  char* exprs[20];+	  int  fixexp[20];+          if (hasSrcPos(c)) { foSR = readFO(); }+          parent = readFO();			/* get parent */+          HIDE(fprintf(stderr,"enter parent of 0x%x -> 0x%x\n",fo,parent);)+	  foExprs[0] = readFO();		/* get fun */+	  fread(&arity,sizeof(unsigned char),1,HatFileRandom);+	  for (i=1; i<=arity; i++) {+	    foExprs[i] = readFO();+          }+          id = readAtomAt(foExprs[0]);+	  for (i=1; i<=arity; i++) {+	    (void)readTraceAt(getResult(foExprs[i],True)+                             ,&(exprs[i]),sr,&(fixexp[i]),False,depth-1);+          }+	  *infix = id->fixity;+	  if (isInfix(id->fixity) && c >= 2) {+	    sprintf(buf,"%s",infixPrint(exprs[1],fixexp[1],id->idname,id->fixity+			    ,exprs[2],fixexp[2]));+	    for (i=3; i<=arity; i++) {+	      strcat(buf," ");+	      strcat(buf,exprs[i]);+            }+	  } else {	/* no fixity */+	    sprintf(buf,"(%s",id->idname);+	    for (i=1; i<=arity; i++) {+	      strcat(buf," ");+	      if (isInfix(fixexp[i])) {+	        strcat(buf,"(");+	        strcat(buf,exprs[i]);+	        strcat(buf,")");+	      } else+	        strcat(buf,exprs[i]);+            }+	    strcat(buf,")");+	  }+	  *expr = strdup(buf);+          *sr   = readSRAt(foSR);+          HIDE(fprintf(stderr,"return parent of 0x%x -> 0x%x\n",fo,parent);)+	  return parent;+	} break;+      case ExpChar:+      case ExpInt:+      case ExpInteger:+      case ExpRat:+      case ExpRational:+      case ExpFloat:+      case ExpDouble:+      case ExpValueUse:+      case ExpConstUse:+      case ExpConstDef:+        { FileOffset foSR=0;+          Ident *id;+          if (hasSrcPos(c)) { foSR = readFO(); }+	  parent = readFO();+	  id	 = readValueAt(fo);+	  *infix = id->fixity;+	  sprintf(buf,"%s",id->idname);+	  *expr = strdup(buf);+          *sr   = readSRAt(foSR);+	  return parent;+	} break;+      case ExpGuard:+      case ExpCase:+      case ExpIf:+        { FileOffset foCond, foSR;+	  char* cond;+	  int fixcond;+          if (hasSrcPos(c)) { foSR = readFO(); }+          parent = readFO();			/* get parent */+          HIDE(fprintf(stderr,"enter parent of 0x%x -> 0x%x\n",fo,parent);)+          readFO();				/* skip result */+	  foCond = readFO();			/* get condition */+	  readTraceAt(foCond,&cond,sr,&fixcond,False,depth-1);+          switch (lower5(c)) {+	    case ExpGuard: sprintf(buf,"| "); break;+	    case ExpCase:  sprintf(buf,"case "); break;+	    case ExpIf:    sprintf(buf,"if "); break;+            default: break;+          }+	  if (isInfix(fixcond)) {+	    strcat(buf,"(");+	    strcat(buf,cond);+	    strcat(buf,")");+	  } else+	    strcat(buf,cond);+	  *expr = strdup(buf);+          *sr   = readSRAt(foSR);+          HIDE(fprintf(stderr,"return parent of 0x%x -> 0x%x\n",fo,parent);)+        } break;+      case ExpFieldUpdate:+        {+	} break;+      case ExpProjection:+        { if (hasSrcPos(c)) { readFO(); }+          parent = readFO();	/* throw projective parent away */+          parent = readFO();	/* choose original expression */+	  return readTraceAt(parent, expr, sr, infix, followHidden, depth);+	} break;+      case ExpHidden:+        { FileOffset result;+          parent = readFO();+          result = readFO();+	  if (!followHidden) {+	    sprintf(buf,"{?}");+	    *expr = strdup(buf);+	    return parent; +          } else {+            return readTraceAt(result, expr, sr, infix, followHidden, depth);+          }+	} break;+      case ExpForward:+	{ FileOffset result;+	  result = readFO();+	  return readTraceAt(result, expr, sr, infix, followHidden, depth);+	} break;+      case ExpDoStmt:+        { FileOffset foStmt, foSR;+	  char* stmt;+	  int fixstmt;+          if (hasSrcPos(c)) { foSR = readFO(); }+          HIDE(fprintf(stderr,"enter parent of 0x%x -> 0x%x\n",fo,parent);)+          foStmt = readFO();+	  parent = readTraceAt(foStmt,&stmt,sr,&fixstmt,False,depth-1);+          sprintf(buf,"do "); break;+	  if (isInfix(fixstmt)) {+	    strcat(buf,"(");+	    strcat(buf,stmt);+	    strcat(buf,")");+	  } else+	    strcat(buf,stmt);+	  *expr = strdup(buf);+          *sr   = readSRAt(foSR);+          HIDE(fprintf(stderr,"return parent of 0x%x -> 0x%x\n",fo,parent);)+	} break;+      default: break;+    }+    return parent;+  }+}+++/* print an infix expression correctly according to the given priorities. */+char*+infixPrint (char* str1, int arg1, char* strfn, int fn, char* str2, int arg2)+{+  char buf[10000]; /* fixed size no final solution */++  if (!isInfix(arg1))+      sprintf(buf,"%s",str1);+  else if (priority(arg1) > priority(fn))+      sprintf(buf,"%s",str1);+  else if (priority(arg1) < priority(fn))+      sprintf(buf,"(%s)",str1);+  else if (isInfixN(fn))+      sprintf(buf,"(%s)",str1);+  else+      sprintf(buf,"%s",str1);++  strcat(buf,strfn);++  if (!isInfix(arg2)) {+      strcat(buf,str2);+  } else if (priority(arg2) > priority(fn)) {+      strcat(buf,str2);+  } else if (priority(arg2) < priority(fn)) {+      strcat(buf,"(");+      strcat(buf,str2);+      strcat(buf,")");+  } else if (isInfixN(fn)) {+      strcat(buf,"(");+      strcat(buf,str2);+      strcat(buf,")");+  } else {+      strcat(buf,str2);+  }++  return strdup(buf);+}++++/* The next bunch of utility functions are for hat-trail.+ * ------------------------------------------------------+ *+ *+ */+++/* Open the .hat file */+void+openHatFile (char* prog, char* arg)+{+  int err;+  char header[8];+  progname = basename(prog,0);++  HatFileRandom  = openFile(arg, "");+  HatFileSeq  = openFile(arg, "");+  BridgeFile = openFile(arg,".bridge");+  filesize = sizeFile(arg, "");+  q_position = 0;++  err = fread(header,sizeof(char),8,HatFileRandom);+  if (err!=8) {+    fprintf(stderr,"%s (error): file %s is too short\n",progname,arg);+    exit(1);+  }+  if (strncmp(header,"Hat",3)) {+    fprintf(stderr,"%s (error): file %s\n",progname,arg);+    fprintf(stderr,"   does not appear to be a Hat archive.  Quitting.\n");+    exit(1);+  }+  if (strncmp(header+3,FILEVERSION,4)) {+    fprintf(stderr,"%s (warning): file %s\n",progname,arg);+    fprintf(stderr,"   appears to be a Hat archive in format %s\n",header+3);+    fprintf(stderr,"   but this tool deals with format version %s\n",FILEVERSION);+    fprintf(stderr,"   I'm continuing, but there may be unexpected errors.\n");+  }+  errorRoot = readFO();+  errorMsg  = readFO();+  if (errorMsg==Entered) interrupt=True;+//  signal(SIGINT,SIG_IGN);+}++void closeHatFile (void)+{+  fclose(HatFileRandom);+  fclose(HatFileSeq);+  fclose(BridgeFile);+}++/* Return the contents of the bridge file, one item at a time.  */+FileOffset+getBridgeValue (void)+{+  int err;+  FileOffset fo;+  err = fread(&fo,sizeof(FileOffset),1,BridgeFile);+  if (err==0) {+     fclose(BridgeFile);+     return 0;+  } else return ntohl(fo);+}++/* Get the trace reference for an error, and the string associated with it. */+FileOffset+getErrorLoc (void)+{+  FileOffset fo;+  fseek(HatFileRandom,8,SEEK_SET);+  fo = readFO();+  return fo;+}+char *+errorMessage (void)+{+  FileOffset fo;+  char c='\0';+  fseek(HatFileRandom,12,SEEK_SET);+  fo = readFO();+  if (fo==Entered) return "Interrupted (^C)";+  if (fo) {+    HIDE(fprintf(stderr,"errorMessage 0x%x\n",fo);)+    freadAt(fo,&c,sizeof(char),1,HatFileRandom);+    if (lower5(c)==AtomAbstract) return readString();+  }+  return "";+}+char*+versionNumber (void)+{+  return strdup(VERSION);+}+++/* Read the tag bits and report the NodeType. */+int+getNodeType (FileOffset fo)+{+  char c;+  if (fo<=DoLambda) return -1;+  HIDE(fprintf(stderr,"getNodeType 0x%x\n",fo);)+  freadAt(fo,&c,sizeof(char),1,HatFileRandom);+  return (int)(lower5(c));	/* lower 5 bits are the identifying tag */+}++/* For any node type, get its parent.  If it doesn't have one, we give 0.  */+FileOffset+parentNode (FileOffset fo)+{+  char c;+  HIDE(fprintf(stderr,"parentNode 0x%x\n",fo);)+  if (fo<=DoLambda) return 0;+  freadAt(fo,&c,sizeof(char),1,HatFileRandom);+  switch (lower5(c)) {+    case ListCons:+    case Module:+    case SrcPos:+    case AtomVariable:+    case AtomConstructor:+    case AtomAbstract:+        return 0;+        break;+    case ExpApp:+    case ExpValueApp:+    case ExpChar:+    case ExpInt:+    case ExpInteger:+    case ExpRat:+    case ExpRational:+    case ExpFloat:+    case ExpDouble:+    case ExpValueUse:+    case ExpConstUse:+    case ExpConstDef:+    case ExpGuard:+    case ExpCase:+    case ExpIf:+    case ExpFieldUpdate:+    case ExpProjection:+    case ExpHidden:+        if (hasSrcPos(c)) { readFO(); }+        return readFO();+        break;+    case ExpForward:+    case ExpDoStmt:+        if (hasSrcPos(c)) { readFO(); }+        return parentNode(readFO());+        break;+  }+}++/* Only for Exp nodes of value kind, we give back a string representation+ * of the name (identifier, Integer, Double, etc), and its fixity etc.+ * The predicate isLiteral reports True for values of basic+ * types like Int, Char, Double etc, and isConstructor identifies Constrs.+ */+char *+getNm (FileOffset fo)+{+  char *id;+  Ident *name = readValueAt(fo);+  if (name) {+    id = name->idname;+    free(name);+    HIDE(fprintf(stderr,"getNm: %s\n",id);)+    return id;+  } else+    return "";+}+char *+getNmMod (FileOffset fo)+{+  char *id;+  Ident *name = readValueAt(fo);+  if (name) {+    id = name->modname;+    free(name);+    return id;+  } else+    return "";+}+int+getFixity (FileOffset fo)+{+  int f;+  Ident *name = readValueAt(fo);+  if (name) {+    f = (int)name->fixity;+    HIDE(fprintf(stderr,"getFixity: %d (%s)\n",f,name->idname);)+    free(name);+    return f;+  } else+    return (int)noFixity;+}+Bool+isLiteral (FileOffset fo)+{+  Bool b;+  Ident *name = readValueAt(fo);+  if (name) {+    b = (name->atomtype == Literal);+    free(name);+    return b;+  } else+    return False;+}+Bool+isConstructor (FileOffset fo)+{+  Bool b;+  Ident *name = readValueAt(fo);+  if (name) {+    b = (name->atomtype == Constructor) || (name->atomtype == ConstrFields);+    free(name);+    return b;+  } else+    return False;+}+Bool+isConstrFields (FileOffset fo)+{+  Bool b;+  char c;+  Ident *name;+  freadAt(fo,&c,sizeof(char),1,HatFileRandom);+  switch (lower5(c)) {+      case AtomVariable:+      case AtomConstructor:+      case AtomAbstract:+          name = readAtomAt(fo);+          break;+      default:+          name = readValueAt(fo);+          break;+  }+  if (name) {+    b = (name->atomtype == ConstrFields);+    free(name);+    HIDE(fprintf(stderr,"isConstrFields 0x%x: %s %s\n",fo,name->idname,+                                                  (b ? "True" : "False"));)+    return b;+  } else+    return False;+}+Bool+isLambda (FileOffset fo)+{+  Bool b; unsigned char c;+  HIDE(fprintf(stderr,"isLambda 0x%x\n",fo);)+  freadAt(fo,&c,sizeof(unsigned char),1,HatFileRandom);+  switch (lower5(c)) {+    case ExpValueUse:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        if (readFO()==Lambda) return True;+        else return False;+        break;+    default:+        return False;+        break;+  }+}+Bool+isDoLambda (FileOffset fo)+{+  Bool b; unsigned char c;+  HIDE(fprintf(stderr,"isDoLambda 0x%x\n",fo);)+  freadAt(fo,&c,sizeof(unsigned char),1,HatFileRandom);+  switch (lower5(c)) {+    case ExpValueUse:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        if (readFO()==DoLambda) return True;+        else return False;+        break;+    default:+        return False;+        break;+  }+}+++/* Get the an name of an identifier out of its struct Ident. */+char*+identName     (Ident* id) { return id->idname; }+char*+identModName  (Ident* id) { return id->modname; }+char*+identSrcFile  (Ident* id) { return id->srcname; }+int+identFixity   (Ident* id) { return (int)id->fixity; }+int+identArity    (Ident* id) { return (int)id->arity; }+int+identDefnLine (Ident* id) { return id->defnline; }+int+identDefnCol  (Ident* id) { return id->defncolumn; }+int+identDefnLineEnd (Ident* id) { return id->defnlineend; }+int+identDefnColEnd  (Ident* id) { return id->defncolumnend; }+Bool+identIsTraced (Ident* id) { return id->isTraced; }+++/* For all nodes, get number of arguments. */+int+getExpArity (FileOffset fo)+{+  char c;+  HIDE(fprintf(stderr,"getExpArity 0x%x\n",fo);)+  freadAt(fo,&c,sizeof(char),1,HatFileRandom);+  switch (lower5(c)) {+    case ExpApp:+    case ExpFieldUpdate:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        readFO();				/* skip result */+        readFO();				/* skip fun/constructor */+        fread(&c,sizeof(char),1,HatFileRandom);	/* get arity */+        return (int)(c);+        break;+    case ExpValueApp:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        readFO();				/* skip constructor */+        fread(&c,sizeof(char),1,HatFileRandom);	/* get arity */+        return (int)c;+        break;+    case AtomConstructor:			/* only interested in fields */+        if (!hasFields(c)) { return 0; }+        readFO();				/* skip module */+        { int x; fread(&x,sizeof(int),1,HatFileRandom); }+        { int x; fread(&x,sizeof(int),1,HatFileRandom); }+        { char x; fread(&x,sizeof(char),1,HatFileRandom); }+        { char arity; fread(&arity,sizeof(char),1,HatFileRandom);+          return (int)arity; }+        break;+    case Module:+    case SrcPos:+    case ExpChar:+    case ExpInt:+    case ExpInteger:+    case ExpRat:+    case ExpRational:+    case ExpFloat:+    case ExpDouble:+    case ExpValueUse:+    case ExpConstUse:+    case ExpConstDef:+    case ExpGuard:+    case ExpCase:+    case ExpIf:+    case ExpProjection:+    case ExpHidden:+    case ExpForward:+    case ExpDoStmt:+    case AtomVariable:+    case AtomAbstract:+        return 0;+        break;+  }+}++/* For all nodes, get the value of the n'th subexpression.  For basic values,+ * the 0'th subexpr is the node itself.  For an application, the 0'th subexpr+ * is the final result of the fun ptr, the k'th subexpr is the final result of+ * the k'th argument.  In the case where a fun/arg resolves to an atom,+ * we return the atom pointer rather than an Exp pointer - the Haskell code+ * can interpret either form.+ */+FileOffset+getExpArg (FileOffset fo, int n)+{+  char c;+  int i=0;+  FileOffset ptr;+  HIDE(fprintf(stderr,"getExpArg 0x%x\n",fo);)+  freadAt(fo,&c,sizeof(char),1,HatFileRandom);+  switch (lower5(c)) {+    case ExpApp:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        readFO();				/* skip result */+        ptr = readFO();				/* fun/constructor */+        if (n==0) return getResult(ptr,True);+        fread(&c,sizeof(char),1,HatFileRandom);	/* get arity */+        if (n<=c) {+          for (i=1; i<n; i++) readFO();		/* skip other args */+          ptr = readFO();			/* get n'th arg */+          return getResult(ptr,True);+        } else+          return fo;+        break;+    case ExpValueApp:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        ptr = readFO();				/* fun/constructor */+        if (n==0) return ptr;	/* no result-chain - fun is already an atom */+        fread(&c,sizeof(char),1,HatFileRandom);	/* get arity */+        if (n<=c) {+          for (i=1; i<n; i++) readFO();		/* skip other args */+          ptr = readFO();			/* get n'th arg */+          return getResult(ptr,True);+        } else+          return fo;+        break;+    case ExpValueUse:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        ptr = readFO();				/* CAF */+        return ptr;	/* no result-chain - fun is already an atom */+        break;+    case ExpConstDef:+    case ExpConstUse:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        ptr = readFO();				/* CAF */+        return getResult(ptr,True);+        break;+    case ExpGuard:+    case ExpCase:+    case ExpIf:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        readFO();				/* skip result */+        ptr = readFO();				/* get condition */+        return getResult(ptr,True);+        break;+    case ExpFieldUpdate:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        readFO();				/* skip result */+        ptr = readFO();				/* exp/constructor */+        if (n==0) return getResult(ptr,True);+        fread(&c,sizeof(char),1,HatFileRandom);	/* get arity */+        if (n<=c) {+          for (i=0; i<c; i++) readFO();		/* skip binder labels */+          for (i=1; i<n; i++) readFO();		/* skip other bindees */+          ptr = readFO();			/* get n'th bindee */+          return getResult(ptr,True);+        } else+          return fo;+        break;+    case ExpProjection:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        ptr = readFO();				/* get expr */+        return ptr;+        break;+    case ExpForward:+        ptr = readFO();				/* get expr */+        return ptr;+        break;+    case ExpChar:+    case ExpInt:+    case ExpInteger:+    case ExpRat:+    case ExpRational:+    case ExpFloat:+    case ExpDouble:+    case ExpHidden:+    case ExpDoStmt:+    case Module:+    case SrcPos:+    case AtomVariable:+    case AtomConstructor:+    case AtomAbstract:+    default:+        return fo;+        break;+  }+}++/* Get the n'th subexpression (*not* its value), + * for any node that has subexpressions. + */+FileOffset+peekExpArg (FileOffset fo, int n)+{+  char c;+  int i=0;+  FileOffset ptr;+  HIDE(fprintf(stderr,"peekExpArg 0x%x\n",fo);)+  assert (n>=0);+  freadAt(fo,&c,sizeof(char),1,HatFileRandom);+  switch (lower5(c)) {+    case ExpApp:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        readFO();				/* skip result */+        ptr = readFO();				/* fun/constructor */+        if (n==0) return ptr;+        fread(&c,sizeof(char),1,HatFileRandom);	/* get arity */+        assert (n<=c);+        for (i=1; i<n; i++) readFO();		/* skip other args */+        ptr = readFO();		                /* get n'th arg */+        return ptr;+        break;+    case ExpValueApp:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        ptr = readFO();				/* fun/constructor */+        if (n==0) return ptr;+        fread(&c,sizeof(char),1,HatFileRandom);	/* get arity */+        assert (n<=c);+        for (i=1; i<n; i++) readFO();		/* skip other args */+        ptr = readFO();			        /* get n'th arg */+        return ptr;+        break;+    case ExpValueUse:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        ptr = readFO();				/* only arg */+        return ptr;	/* this is an atom */+        break;+    case ExpConstDef:+    case ExpConstUse:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        ptr = readFO();				/* only arg */+        return ptr;+        break;+    case ExpGuard:+    case ExpCase:+    case ExpIf:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        readFO();				/* skip result */+        ptr = readFO();				/* get condition */+        return ptr;+        break;+    case ExpFieldUpdate:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        readFO();				/* skip result */+        ptr = readFO();				/* exp/constructor */+        if (n==0) return ptr;+        fread(&c,sizeof(char),1,HatFileRandom);	/* get arity */+        assert (n<=c);+        for (i=0; i<c; i++) readFO();		/* skip binder labels */+        for (i=1; i<n; i++) readFO();		/* skip other bindees */+        ptr = readFO();			        /* get n'th bindee */+        return ptr;+        break;+    case ExpProjection:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        ptr = readFO();				/* get expr */+        return ptr;+        break;+    case ExpForward:+        ptr = readFO();				/* get expr */+        return ptr;+        break;+    case ExpHidden:+        readFO();				/* skip parent */+        readFO();                               /* skip result */+        ptr = readFO();			        /* get child list */+        return ptr;+        break;+    case ListCons:+        ptr = readFO();                         /* get element */+        if (n==1) return ptr;+        ptr = readFO();                         /* get tail */+        return ptr;+        break;+    case ExpChar:+    case ExpInt:+    case ExpInteger:+    case ExpRat:+    case ExpRational:+    case ExpFloat:+    case ExpDouble:+    case ExpDoStmt:+    case Module:+    case SrcPos:+    case AtomVariable:+    case AtomConstructor:+    case AtomAbstract:+    default:+        assert (False);+        break;+  }+}++/* Only for an ExpFieldUpdate node, or an ExpConstructor that has fields,+ * get the atom pointer of the n'th label.+ */+FileOffset+getFieldLabel (FileOffset fo, int n)+{+  char c;+  int i=0;+  FileOffset ptr;+  HIDE(fprintf(stderr,"getFieldLabel 0x%x: n=%d\n",fo,n);)+  freadAt(fo,&c,sizeof(char),1,HatFileRandom);+  switch (lower5(c)) {+    case ExpFieldUpdate:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        readFO();				/* skip result */+        readFO();				/* skip exp/constructor */+        fread(&c,sizeof(char),1,HatFileRandom);	/* get arity */+        if (n<=c) {+          for (i=1; i<n; i++) readFO();		/* skip other labels */+          ptr = readFO();			/* get n'th label */+          return ptr;+        } else+          return 0;+        break;+    case ExpValueUse:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        ptr = readFO();				/* atom pointer */+        return getFieldLabel(ptr,n);+        break;+    case AtomConstructor:+        if (hasFields(c)) {+          readFO();				/* skip module ptr */+          { int x; fread(&x,sizeof(int),1,HatFileRandom); }+          { int x; fread(&x,sizeof(int),1,HatFileRandom); }+          { char x; fread(&x,sizeof(char),1,HatFileRandom); }+          { char arity; fread(&arity,sizeof(char),1,HatFileRandom);+            readString();+            while (n--) readFO();+            ptr = readFO();+            HIDE(fprintf(stderr,"getFieldLabel: return 0x%x\n",ptr);)+            return ptr; }+        } else {+          fprintf(stderr,"constructor at 0x%x has no field labels\n",fo);+          return 0;+        } break;+    default:+        return 0;+        break;+  }+}++/* Get the SrcRef belonging to any node type.  If the node doesn't have+ * one, we give back a 0 reference.+ */+FileOffset+getSrcRef (FileOffset fo)+{+  char c;+  int i;+  HIDE(fprintf(stderr,"getSrcRef 0x%x\n",fo);)+  if (fo<=DoLambda) return 0;+  freadAt(fo,&c,sizeof(char),1,HatFileRandom);+  if (hasSrcPos(c)) {+    return readFO();			/* get SrcRef */+  } else {+    return 0;+  }+}++/* Get the Atom node for the fun position of an expression. + * If the node doesn't look right, we give back a 0 reference.+ */+FileOffset+getDefnRef (FileOffset fo)+{+  char c;+  int i;+  FileOffset ptr;+  if (fo==0) return 0;+  HIDE(fprintf(stderr,"getDefnRef 0x%x\n",fo);)+  freadAt(fo,&c,sizeof(char),1,HatFileRandom);+  switch (lower5(c)) {+    case ExpApp:+        if (hasSrcPos(c)) { readFO(); }		/* skip use position */+        readFO();				/* skip parent */+        readFO();				/* skip result */+        ptr = readFO();				/* get fun */+        return getDefnRef(ptr);			/* and follow it */+        break;+    case ExpValueApp:+    case ExpValueUse:+        if (hasSrcPos(c)) { readFO(); }		/* skip use position */+        readFO();				/* skip parent */+        ptr = readFO();				/* get Atom */+        return ptr;+        break;+    case ExpConstUse:+        if (hasSrcPos(c)) { readFO(); }		/* skip use position */+        readFO();				/* skip parent */+        ptr = readFO();				/* get ExpConstDef pointer */+        return getDefnRef(ptr);			/* and follow it */+        break;+    case ExpConstDef:				/* never a use position */+        readFO();				/* skip parent */+        readFO();				/* skip result */+        ptr = readFO();				/* get Atom */+        return ptr;+        break;+    case AtomVariable:+    case AtomConstructor:+        return fo;+        break;+    default:+        return 0;+        break;+  }+}+++/* peekTrace() takes a peek backwards at a trace (or indirection), skipping+ * over any Hidden or Projection nodes to find the nearest "real" trace.+ * It is used by the code that clumps together characters in the output+ * by their shared parentage.+ */+FileOffset+peekTrace(FileOffset fo)+{+  char c;++  while (1) {		/* iterate until we find a `real' node */+    if (fo<=DoLambda) return 0;	/* trace is Root/Unevaluated/Entered/etc */+    HIDE(fprintf(stderr,"peekTrace 0x%x\n",fo);)+    freadAt(fo,&c,sizeof(char),1,HatFileRandom);+    switch (c) {+      case ExpProjection:+          if (hasSrcPos(c)) { readFO(); }	/* skip use position */+          fo = readFO();			/* get parent */+          break;				/* and look again */+      case ExpHidden:+      case ExpForward:+          fo = readFO();			/* get parent */+          break;				/* and look again */++      case Module:+      case SrcPos:+      case AtomVariable:+      case AtomConstructor:+      case AtomAbstract:+          fprintf(stderr,"peekTrace failed\n");+          exit(1);++      default:+          return fo;			/* found a `real' node! */+          break;+    }+  }+}+++/* getResult() returns the result of an application, or 0 if there is+ * apparently no result.  (Results can also be Unevaluated, Entered,+ * or Interrupted).  To find the result, it is necessary to follow+ * the result-pointer chain right to the end (but only as far as the+ * terminating Exp, not right down to an Atom).  If the final result+ * is Unevaluated, Entered, Interrupted, or Lambda, then we return+ * the previous step of the chain.  (The pretty printer then decides+ * how to represent these to the user.)+ *+ * It turns out that a result chain can contain a cycle, which we must+ * detect.  A cycle always involves some Forwards and one Hidden.  It+ * is sufficient to record the most recent Hidden that was seen, and+ * if we come across it again, just stop and return the Hidden.+ */+static FileOffset mostRecentHidden=0;++FileOffset+getResult (FileOffset fo, Bool stopAtHidden)+{+  if (fo==mostRecentHidden) return fo;+  mostRecentHidden=0;+  return getResultNoCycle(fo,stopAtHidden);+}++#define fixInterrupt(fo)	(interrupt && fo==Entered ? Interrupted : fo)+FileOffset+getResultNoCycle (FileOffset fo, Bool stopAtHidden)+{+  char c;+  FileOffset result;++  HIDE(fprintf(stderr,"getResult 0x%x\n",fo);)+  if (fo<=DoLambda) return fixInterrupt(fo);      /* trace is Unevaluated etc */+  freadAt(fo,&c,sizeof(char),1,HatFileRandom);+  switch (lower5(c)) {+    case ExpApp:+    case ExpGuard:+    case ExpCase:+    case ExpIf:+    case ExpFieldUpdate:+        if (hasSrcPos(c)) { readFO(); }		/* skip use position */+        readFO();				/* skip parent */+        result = readFO();			/* get result */+        HIDE(fprintf(stderr,"getResult: result is 0x%x\n",result);)+        if (result==fo) return fo;+        else if (result<=DoLambda) return fixInterrupt(fo);+        else return getResultNoCycle(result,False);+        break;+//  case ExpValueApp:+//  case ExpValueUse:+//      if (hasSrcPos(c)) { readFO(); }		/* skip use position */+//      readFO();				/* skip parent */+//      return readFO();			/* return Atom pointer */+//      break;+    case ExpConstUse:+        if (hasSrcPos(c)) { readFO(); }		/* skip use position */+        readFO();				/* skip parent */+        result = readFO();			/* get result */+        if (result<=DoLambda) return fixInterrupt(fo);+        else return getResultNoCycle(result,False);+						/* follow ExpConstDef pointer */+        break;+    case ExpConstDef:+        readFO();				/* skip parent */+        result = readFO();			/* get result */+        if (result<=DoLambda) return fixInterrupt(fo);+        return getResultNoCycle(result,False);+        break;+    case ExpForward:+        return getResultNoCycle(readFO(),stopAtHidden);+        break;					/* continue to detect Hidden */+    case ExpDoStmt:+        return getResultNoCycle(readFO(),False);	/* get result */+        break;+    case ExpProjection:+        return fo;+    case ExpValueApp:+    case ExpValueUse:+    case ExpChar:+    case ExpInt:+    case ExpInteger:+    case ExpRat:+    case ExpRational:+    case ExpFloat:+    case ExpDouble:+//  case AtomVariable:+//  case AtomConstructor:+//  case AtomAbstract:+        HIDE(fprintf(stderr,"getResult: result is itself\n");)+        return fo;+        break;+    case ExpHidden:+        if (stopAtHidden) return fo;+        else if (fo==mostRecentHidden) return fo;+        else {+          mostRecentHidden = fo;		/* keep, to detect a loop */+          readFO();				/* skip parent */+          result = readFO();			/* get result */+          if (result==fo) return fo;+          else if (result<=DoLambda) return fixInterrupt(fo);+          else return getResultNoCycle(result,False);+        }+        break;+    case AtomVariable:+    case AtomConstructor:+    case AtomAbstract:+    default:+        return 0;+        break;+  }+}++/* peekResult() is a one-step look at the result pointer.  It does not+ * follow the whole chain.  It is mainly used to decide whether the+ * pointer returned by getResult() leads directly to an Unevaluated,+ * Entered, Interrupted, or Lambda.+ */+FileOffset+peekResult (FileOffset fo)+{+  char c;+  FileOffset result;++  HIDE(fprintf(stderr,"peekResult 0x%x\n",fo);)+  if (fo<=DoLambda) return fixInterrupt(fo);      /* trace is Unevaluated etc */+  freadAt(fo,&c,sizeof(char),1,HatFileRandom);+  switch (lower5(c)) {+    case ExpApp:+    case ExpGuard:+    case ExpCase:+    case ExpIf:+    case ExpFieldUpdate:+        if (hasSrcPos(c)) { readFO(); }		/* skip use position */+        readFO();				/* skip parent */+        result = readFO();			/* get result */+        return fixInterrupt(result);+        break;+    case ExpConstUse:+    case ExpProjection:+        if (hasSrcPos(c)) { readFO(); }		/* skip use position */+        readFO();				/* skip parent */+        result = readFO();			/* get result */+        return fixInterrupt(result);+        break;+    case ExpConstDef:+        readFO();				/* skip parent */+        result = readFO();			/* get result */+        return fixInterrupt(result);+        break;+    case ExpForward:+    case ExpDoStmt:+        result = readFO();			/* get result */+        return fixInterrupt(result);+        break;+    case ExpValueApp:+    case ExpValueUse:+    case ExpChar:+    case ExpInt:+    case ExpInteger:+    case ExpRat:+    case ExpRational:+    case ExpFloat:+    case ExpDouble:+        HIDE(fprintf(stderr,"getResult: result is itself\n");)+        return fo;+        break;+    case ExpHidden:+        readFO();				/* skip parent */+        result = readFO();			/* get result */+        return fixInterrupt(result);+        break;+    case AtomVariable:+    case AtomConstructor:+    case AtomAbstract:+    default:+        return 0;+        break;+  }+}+++/* Comparison of FileOffsets is the basic key-ordering for finite maps,+ * used for gathering and looking up information during a linear sweep+ * of the .hat file (in hat-observe and hat-detect).+ */+int+fileoffset_compare (FileOffset i, FileOffset j) /* for ordering the tree */+{+  if (i<j) return -1;+  else if (i==j) return 0;+  else return 1;+}++/* Signal handler for user-interruption */+void+ctrlC (int sig)+{ hat_interrupted = True; }+++/* sequential access from Haskell */+void+q_init (void)+{+  q_position  = 0x10;+  fseek(HatFileSeq,q_position,SEEK_SET);+}+char+q_tag (void)+{+  char c;+  c = (char)fgetc(HatFileSeq);+  q_position+=1;+  return lower5(c);+}+
+ tools/artutils.h view
@@ -0,0 +1,125 @@+#ifndef _ARTUTILS_H+#define _ARTUTILS_H++#include "art.h"+#if defined(sparc)+#include <sys/byteorder.h>+#endif++extern FileOffset errorRoot, errorMsg, remoteStartNode;+extern FileOffset q_position;+extern FILE	*HatFileRandom, *HatFileSeq, *OutputFile, *BridgeFile;+extern char*	progname;			/* browser program name */+extern unsigned	filesize, outputsize;+extern Bool	hat_interrupted;++typedef enum {+  Literal, Variable, Constructor, ConstrFields, Abstract+} AtomType;++typedef struct {+  char* srcname;+  int   line;+  int   column;+  int   lineend;+  int   columnend;+} SrcRef;++typedef struct {+  char* idname;+  char* modname;+  char* srcname;+  char  fixity;+  char  arity;+  int   defnline;+  int   defncolumn;+  int   defnlineend;+  int   defncolumnend;+  Bool  isTraced;+  AtomType  atomtype;+} Ident;++void		finalise	(void);+FILE*		openFile	(char* base, char* ext);+int		sizeFile	(char* base, char* ext);+int		freadAt		(FileOffset fo, void* ptr+				,int size, int nmemb, FILE* stream);+FileOffset	readFO		(void);+char*		readString	(void);+int		q_fread		(void* ptr, int size, int nmemb, FILE* stream);+FileOffset	q_readFO	(void);+char*		q_readString	(void);+char		q_peek		(void);+char		q_tag		(void);+void		q_init		(void);+void		readModuleAt	(FileOffset fo, char** modname, char** srcname+				,Bool* traced);+Ident*		readAtomAt	(FileOffset fo);+Ident*		readValueAt	(FileOffset fo);+SrcRef*		readSRAt	(FileOffset fo);+FileOffset	q_skipNode	(char tag);+FileOffset	currentfilepos	(void);++FileOffset	readTraceAt	(FileOffset fo, char** expr, SrcRef** sr+				,int* infix,int followHidden,int depth);+char*		infixPrint	( char* str1, int arg1+				, char* strfn, int fn+				, char* str2, int arg2);++#define noFixity      ((char)3)+#define isInfix(fix)  ((fix%4)!=3)+#define isInfixL(fix) ((fix%4)==2)+#define isInfixR(fix) ((fix%4)==1)+#define isInfixN(fix) ((fix%4)==0)+#define priority(fix) (fix/4)++/* prototypes for common ui */+void		openHatFile	(char* prog, char* arg);+void        closeHatFile (void);+FileOffset	getBridgeValue	(void);+FileOffset	getErrorLoc	(void);+char*		errorMessage	(void);+char*		versionNumber	(void);+int		getNodeType	(FileOffset fo);+FileOffset	parentNode	(FileOffset fo);+char*		getNm		(FileOffset fo);+char*		getNmMod	(FileOffset fo);+int		getFixity	(FileOffset fo);+Bool		isLiteral	(FileOffset fo);+Bool		isConstructor	(FileOffset fo);+Bool		isConstrFields	(FileOffset fo);+Bool		isLambda	(FileOffset fo);+Bool		isDoLambda	(FileOffset fo);+char*		identName	(Ident* id);+char*		identModName	(Ident* id);+char*		identSrcFile	(Ident* id);+int		identFixity	(Ident* id);+int		identArity	(Ident* id);+int		identDefnLine	(Ident* id);+int		identDefnCol	(Ident* id);+int		identDefnLineEnd(Ident* id);+int		identDefnColEnd	(Ident* id);+Bool		identIsTraced	(Ident* id);+int		getExpArity	(FileOffset fo);+FileOffset	getExpArg	(FileOffset fo, int n);+FileOffset      peekExpArg      (FileOffset fo, int n);+FileOffset	getFieldLabel	(FileOffset fo, int n);+FileOffset	getSrcRef	(FileOffset fo);+FileOffset	getDefnRef	(FileOffset fo);+FileOffset	peekTrace	(FileOffset fo);+FileOffset	getResult	(FileOffset fo, Bool stopAtHidden);+FileOffset	getResultNoCycle(FileOffset fo, Bool stopAtHidden);+FileOffset	peekResult	(FileOffset fo);++char*		srFile		(SrcRef* sr);+int		srLine		(SrcRef* sr);+int		srColumn	(SrcRef* sr);+int		srLineEnd	(SrcRef* sr);+int		srColumnEnd	(SrcRef* sr);+++/* prototypes for other tools */+void		ctrlC			(int sig);+int		fileoffset_compare	(FileOffset i, FileOffset j);++#endif
+ tools/checkglib.h view
@@ -0,0 +1,1 @@+
+ tools/detectutils.c view
@@ -0,0 +1,201 @@+/*+ *  Utility functions for hat-detect.+ */+#include <stdio.h>+#include <errno.h>++#ifdef DEBUG+#define HIDE(x) x+#else+#define HIDE(x)+#endif++#include "detectutils.h"++/* Return the next child of any of the parents in the ParentSet.  */+FileOffset+nextChild (ParentSet* ps)+{+  FileOffset node=0;+  /* keep searching one node at a time until a valid child turns up */+  do { node = childSearch(ps); } while (!node);+  return node;+}+++/* Skip past one node of the file, returning its position if it is a child+ * of any of the parents in the ParentSet, or 0 otherwise.+ */+FileOffset+childSearch (ParentSet* ps)+{+  unsigned char c; int err;+  FileOffset parent, node = q_position;+  if (hat_interrupted) return 3;+  err = q_fread(&c,sizeof(unsigned char),1,HatFileSeq);+  if (err!=1) {+    return 1;	/* Assume EOF */+  }+  HIDE(fprintf(stderr,"childSearch: 0x%x, %d\n",node,c);)+  switch (lower5(c)) {	/* lower 5 bits identify the TraceType */+    case ExpApp:+    case ExpValueApp:+    case ExpValueUse:+    case ExpConstUse:+    case ExpProjection:+    case ExpConstDef:+    case ExpGuard:+    case ExpCase:+    case ExpIf:+    case ExpFieldUpdate:+    case ExpHidden:+    case ExpForward:+    case ExpDoStmt:+        parent = q_skipNode(c);+        if (elemParentSet(parent,ps)) return node; else return 0;+        break;+    default:+        q_skipNode(c); return 0; break;+  }+}+++/* Print a message to stderr if the asserted condition is violated. */+void+assert (Bool cond, char *act)+{+  if (!cond) {+    fprintf(stderr,"Assertion failed: %s at 0x%x\n",act,q_position);+  }+}++/* Look for the file node that corresponds to the definition of Main.main */+FileOffset+findMainUse (Bool findUse)+{+    FileOffset fo;+    FileOffset atom;+    FileOffset def;+    FileOffset use;+    char c;+    char *str;+    +    // We should find the main module at 0x10+    fseek(HatFileSeq,0x10,SEEK_SET); q_position=0x10;+    q_fread(&c,sizeof(char),1,HatFileSeq);+    assert (lower5(c)==Module, "Module tag");+    str = q_readString();+    assert (!strcmp(str,"Main"),"Module is Main");+    +    // The next thing shoult be the atom variable belonging to that module+    q_readString();+    atom = q_position;+    q_fread(&c,sizeof(char),1,HatFileSeq);+    assert (lower5(c)==AtomVariable, "AtomVariable tag");+    fo = q_readFO();+    assert (fo==0x10, "AtomVariable module is Main");+    +    {	/* skip defnpos */+        int x;+        q_fread(&x,sizeof(int),1,HatFileSeq);+    }+    {	/* skip defnpos */+        int x;+        q_fread(&x,sizeof(int),1,HatFileSeq);+    }+    {	/* skip fixity */+        char x;+        q_fread(&x,sizeof(char),1,HatFileSeq);+    }+    +    // Main takes no arguments+    q_fread(&c,sizeof(char),1,HatFileSeq);+    assert (c==0, "AtomVariable has arity 0");+    +    // Make sure the deffinition is main+    str = q_readString();+    assert (!strcmp(str,"main"),"AtomVariable is main");+    +    // Make sure there is a constant definition pointing at main+    def = q_position;+    q_fread(&c,sizeof(char),1,HatFileSeq);+    assert (lower5(c)==ExpConstDef, "ExpConstDef tag");+    q_readFO(); q_readFO();+    fo = q_readFO();+    assert (fo==atom, "ExpConstDef points to AtomVariable main");+    +    // Make sure that main is called+    use = q_position;+    q_fread(&c,sizeof(char),1,HatFileSeq);+    assert (lower5(c)==ExpConstUse, "ExpConstUse tag");+    if (hasSrcPos(c)) q_readFO();+    q_readFO();+    fo = q_readFO();+    assert(fo==def, "ExpConstUse points to ExpConstDef");+    +    if (findUse)+    {+        return use;+    }+    else+    {+        return def;+    }+    +    /* postcondition: q_position points to first node following ExpConstUse */+}+++/* Decide whether to ask a question in hat-detect, by determining whether+ * any of the functional identifiers in an expression are untrusted.+ * Originally, we thought that only the 'real' function being applied+ * mattered.  But in a higher-order application like (filter f ...) then+ * we are probably interested in asking the question if f is suspect, even+ * though filter is trusted.  Even this is only an approximation, because+ * (filter f [] = []) is an uninteresting question - but it is too expensive+ * to search for any children of the node, just to rule it out when no + * children are found. */+Bool+anySuspect (FileOffset fo)+{+  char c, i;+  FileOffset ptr[20];		/* applications only recorded up to arity 15 */+  FileOffset r;+  if (fo==0) return False;+  freadAt(fo,&c,sizeof(char),1,HatFileRandom);+  switch (lower5(c)) {+    case ExpApp:+	    HIDE(fprintf(stderr,"anysuspect: 0x%x ExpApp\n",fo);)+        if (hasSrcPos(c)) { readFO(); }		/* skip use position */+	readFO(); readFO();			/* skip parent and result */+	ptr[0] = readFO();			/* get fun */+	fread(&c,sizeof(char),1,HatFileRandom);	/* get arity */+	for (i=1; i<=c; i++) ptr[i] = readFO();	/* get args */+	if (anySuspect(ptr[0])) return True;+	for (i=1; i<=c; i++) {+	  if (anySuspect(getResult(ptr[i],True))) return True;+	}+	return False;				/* fall-through case */+	break;+    case ExpProjection:+    case ExpValueUse:+	    HIDE(fprintf(stderr,"anysuspect: 0x%x ExpValueUse\n",fo);)+        if (hasSrcPos(c)) { readFO(); }		/* skip use position */+	readFO();				/* skip parent */+	ptr[0] = readFO();			/* get Atom */+	return anySuspect(ptr[0]);+	break;+    case AtomVariable:+	    HIDE(fprintf(stderr,"anysuspect: 0x%x AtomVariable\n",fo);)+	ptr[0] = readFO();			/* get Module */+	return anySuspect(ptr[0]);+	break;+    case Module:+	    HIDE(fprintf(stderr,"anysuspect: 0x%x Module\n",fo);)+	return tracedModule(c);			/* check trust bit */+	break;+    default:+       	return False;+	break;+  }+}
+ tools/detectutils.h view
@@ -0,0 +1,13 @@+/*+ *  Utility functions for hat-detect.+ */+#include "art.h"+#include "parentset.h"+#include "artutils.h"++FileOffset	nextChild	(ParentSet* ps);+FileOffset	childSearch	(ParentSet* ps);+void		assert		(Bool cond, char *act);+FileOffset	findMainUse	(Bool findUse);+Bool		anySuspect	(FileOffset fo);+
+ tools/finitemap.c view
@@ -0,0 +1,195 @@+#include <stdlib.h>+#include <stdio.h>+#include "finitemap.h"++#ifndef HAVE_GLIB+/* our own implementation of balanced trees, based on Data.FiniteMap */++#define SIZE_RATIO	5	/* max difference in size of l/r subtrees */+#ifndef NULL+#define NULL 0+#endif++/* internal API */+int	Tree_size	(Tree t);+Tree	Tree_new	(cast key, cast value);+cast	Tree_lookup	(Tree t, FMComparison cmp, cast key);+Tree	fixSize		(Tree t);+Tree	Tree_insert	(Tree t, FMComparison cmp, cast key, cast value);+Tree	mkBalTree	(Tree t, Tree l, Tree r);+void	Tree_traverse	(Tree t, FMTraversal f, Ordering o);+void	Tree_destroy	(Tree t, FMFreeItem del);+++/* implementation */+FiniteMap+FM_new (FMComparison cmp, FMFreeItem del)+{+  FiniteMap fm;+  fm = (FiniteMap)malloc(sizeof(struct _FM));+  fm->root = (Tree)NULL;+  fm->cmp  = cmp;+  fm->del  = del;+  return fm;+}++Tree+Tree_new (cast key, cast value)+{+  Tree t;+  t = (Tree)malloc(sizeof(struct _Tree));+  t->key   = key;+  t->value = value;+  t->size  = 1;+  t->left  = (cast)NULL;+  t->right = (cast)NULL;+  return t;+}++int+Tree_size (Tree t) { return (t? t->size : 0); }++cast+FM_lookup (FiniteMap fm, cast key)+{+  return Tree_lookup(fm->root,fm->cmp,key);+}++cast+Tree_lookup (Tree t, FMComparison cmp, cast key)+{+  int discrim;+  if (t==NULL) return (cast)NULL;+  discrim = cmp(key,t->key);+  if (discrim==0) {+    return t->value;+  } else if (discrim<0) {+    return Tree_lookup(t->left,cmp,key);+  } else {+    return Tree_lookup(t->right,cmp,key);+  }+}++void+FM_insert (FiniteMap fm, cast key, cast value)+{+  fm->root = Tree_insert(fm->root, fm->cmp, key, value);+}++Tree+Tree_insert (Tree t, FMComparison cmp, cast key, cast value)+{+  int discrim;+  if (t==NULL) return Tree_new(key,value);+  discrim = cmp(key,t->key);+  if (discrim==0) {+    t->value = value;	/* overwrite old value */+    return t;+  } else if (discrim<0) {+    return mkBalTree (t, Tree_insert (t->left, cmp, key, value), t->right);+  } else {+    return mkBalTree (t, t->left, Tree_insert (t->right, cmp, key, value));+  }+}++Tree+fixSize (Tree t)+{+  t->size = Tree_size(t->left) + Tree_size(t->right) + 1;+  return t;+}++Tree+mkBalTree (Tree t, Tree l, Tree r)+{+  int sizeL, sizeR, sizeT;+  sizeL = Tree_size(l);+  sizeR = Tree_size(r);+  sizeT = sizeL+sizeR+1;+  if (sizeL+sizeR < 2) {			/* only one subtree */+    t->left  = l;+    t->right = r;+    t->size  = sizeT;+    return t;+  } else if (sizeR > SIZE_RATIO*sizeL) {	/* right tree too big */+    if (Tree_size(r->left) < 2*Tree_size(r->right)) {+      /* transfer single branch L */+      t->left  = l;+      t->right = r->left;+      r->left  = fixSize(t);+      r->size  = sizeT;+      return r;+    } else {+      /* transfer double L branch of R to root */+      Tree rl;+      rl        = r->left;+      t->left   = l;+      t->right  = rl->left;+      r->left   = rl->right;+      rl->left  = fixSize(t);+      rl->right = fixSize(r);+      rl->size  = sizeT;+      return rl;+    }+  } else if (sizeL > SIZE_RATIO*sizeR) {	/* left tree too big */+    if (Tree_size(l->right) < 2*Tree_size(l->left)) {+      /* transfer single branch R */+      t->right = r;+      t->left  = l->right;+      l->right = fixSize(t);+      l->size  = sizeT;+      return l;+    } else {+      /* transfer double R branch of L to root */+      Tree lr;+      lr        = l->right;+      t->right  = r;+      t->left   = lr->right;+      l->right  = lr->left;+      lr->right = fixSize(t);+      lr->left  = fixSize(l);+      lr->size  = sizeT;+      return lr;+    }+  } else {					/* no imbalance */+    t->left  = l;+    t->right = r;+    t->size  = sizeT;+    return t;+  }+}++void+FM_traverse (FiniteMap fm, FMTraversal f, Ordering o)	/* ordered traversal */+{+  if (fm->root) Tree_traverse (fm->root, f, o);+}++void+Tree_traverse (Tree t, FMTraversal f, Ordering o)+{+  if (o==PreOrder)  (*f)(t->key, t->value, (cast)0);+  if (t->left)  Tree_traverse(t->left, f, o);+  if (o==InOrder)   (*f)(t->key, t->value, (cast)0);+  if (t->right) Tree_traverse(t->right, f, o);+  if (o==PostOrder) (*f)(t->key, t->value, (cast)0);+}++void+FM_destroy (FiniteMap fm)+{+  if (fm->root) Tree_destroy(fm->root, fm->del);+  free(fm);+}++void+Tree_destroy (Tree t, FMFreeItem del)+{+  if (t->left)  Tree_destroy(t->left, del);+  if (t->right) Tree_destroy(t->right, del);+  if (del) { (*del)(t->key, t->value); }+  free(t);+}++#endif+
+ tools/finitemap.h view
@@ -0,0 +1,58 @@+#ifndef _FINITEMAP_H+#define _FINITEMAP_H++#include "checkglib.h"++#ifndef HAVE_GLIB++/* external API */+typedef struct _FM* FiniteMap;+typedef void* cast;+typedef int  (*FMComparison) (cast a, cast b);+typedef int  (*FMTraversal)  (cast key, cast value, cast dummy);+typedef void (*FMFreeItem)   (cast key, cast value);+typedef enum { PreOrder, InOrder, PostOrder } Ordering;++FiniteMap	FM_new		(FMComparison cmp, FMFreeItem del);+cast		FM_lookup	(FiniteMap fm, cast key);+void		FM_insert	(FiniteMap fm, cast key, cast value);+void		FM_traverse	(FiniteMap fm, FMTraversal f, Ordering o);+void		FM_destroy	(FiniteMap fm);++/* internals */+typedef struct _Tree* Tree;+struct _Tree {          /* balanced tree implementation of FiniteMap */+  cast key;+  cast value;+  int size;             /* number of non-null branches in this subtree (>=1) */+  Tree left, right;     /* abs(size(left)-size(right)) <= SIZE_RATIO */+};+struct _FM {+  Tree root;+  FMComparison cmp;+  FMFreeItem del;+};++#else	/* use glib instead */++#include <glib.h>++typedef GTree*	FiniteMap;+#define cast		gpointer+#define FMComparison	GCompareFunc+#define FMTraversal	GTraverseFunc+#define FMFreeItem	++#define Ordering	GTraverseType+#define PreOrder	G_PRE_ORDER+#define InOrder		G_IN_ORDER+#define PostOrder	G_POST_ORDER++#define FM_new(cmp,del)		g_tree_new(cmp)+#define FM_lookup(fm,key)	g_tree_lookup(fm,key)+#define FM_insert(fm,key,value)	g_tree_insert(fm,key,value)+#define FM_traverse(fm,f,o)	g_tree_traverse(fm,f,o,(gpointer)0)+#define FM_destroy(fm)		g_tree_destroy(fm)++#endif+#endif
+ tools/hashtable.h view
@@ -0,0 +1,38 @@+/**************************************************************************/+/* hashtable.h: definition of a hashtable over long integer values        */+/* The hashtable only saves one key, no value can be associated           */+/*                                                                        */+/* Thorsten Brehm, 4/2001                                                 */+/**************************************************************************/+#ifndef _HASHTABLE_H+#define _HASHTABLE_H++#include "art.h"++typedef struct hashelement *HashPtr;++typedef struct hashelement {+  FileOffset value;+  HashPtr next; // Array of all arguments+} HashElement;++typedef struct {+  HashPtr* hashArray;+  unsigned long size;+  unsigned long rehashAt;+  unsigned long incrementSize;+  unsigned long count;+  int outOfMemory;+} HashTable;++HashTable*   newHashTable(unsigned long size); /* return empty table of size */+void         freeHashTable(HashTable* h);+void         addToHashTable(HashTable* h,FileOffset value);+void         removeFromHashTable(HashTable* h,FileOffset value);++/* check for element in hash table */+/* returns 1, if value is in the table */+/*         0 otherwise */+int          isInHashTable(HashTable* h,FileOffset value);++#endif
+ tools/hat-check.c view
@@ -0,0 +1,1031 @@+/* hat-check: reads hat trace files, checking at least the basic format+ * other checks and information can be requested by options+ * Colin Runciman, University of York+ * Original version February 2001+ *   text output as default, with -v option for added verification check+ * 21 March 2001+ *   added -s option for statistics, made text an option (-a)+ * 28 March 2001+ *   added -r option to check proportion of nodes reachable+ * 6 April 2001+ *   -v extended to check for inappropriate zero pointers+ *   -n option added to request textual dump of single node+ *   when both -a & -r set show reachability of each node in text lines+ * 8 May 2001+ *   allow (but ignore) bits to mark SATs with no APP+ *   accept progname with or without .hat+ * 2-4 April 2002 - Malcolm Wallace+ *   Update to new file format.+ * 12 June 2002 - Colin+ *   Added -g option to generate dot-code for graph diagram.+ * 4 August 2004 - Olaf+ *   Update to extended position format (begin and end location).+ */++/* #include <unistd.h> */+#include <sys/types.h>+#include <sys/stat.h>+#include <stdlib.h>+#include <stdio.h>+#include <string.h>+#include <signal.h>+#include <inttypes.h>++#include "art.h"+#include "ntohl.h"++/* out-of-range values must be <= 31 && not overlap Exps and Atoms */+#define ANYEXP	22+#define ANYATOM	23+#define HEADER  24+#define INVALID	30 +#define BEYOND	31++/* prototypes */+void badusage (void);+void initstats (void);+void reportstats (void);+void cleartag (char *b);+void header (void);+void nodes (void);+void nextnode (void);+void markfromheader (uint32_t *buf);+void markfromoutput (char *bridgefile, uint32_t *buf);+void markfrom (uint32_t root, uint32_t *buf);+int strends (char *e, char*s);++/* strings for symbolic constants */+char*+tag2str (int k)+{+  switch (k) {+  case Module:          return "Module"; break;+  case SrcPos:          return "SrcPos"; break;+  case ExpApp:          return "ExpApp"; break;+  case ExpValueApp:     return "ExpValueApp"; break;+  case ExpChar:         return "ExpChar"; break;+  case ExpInt:          return "ExpInt"; break;+  case ExpInteger:      return "ExpInteger"; break;+  case ExpRat:          return "ExpRat"; break;+  case ExpRational:     return "ExpRational"; break;+  case ExpFloat:        return "ExpFloat"; break;+  case ExpDouble:       return "ExpDouble"; break;+  case ExpValueUse:     return "ExpValueUse"; break;+  case ExpConstUse:     return "ExpConstUse"; break;+  case ExpConstDef:     return "ExpConstDef"; break;+  case ExpGuard:        return "ExpGuard"; break;+  case ExpCase:         return "ExpCase"; break;+  case ExpIf:           return "ExpIf"; break;+  case ExpFieldUpdate:  return "ExpFieldUpdate"; break;+  case ExpProjection:   return "ExpProjection"; break;+  case ExpHidden:       return "ExpHidden"; break;+  case ExpForward:      return "ExpForward"; break;+  case ExpDoStmt:       return "ExpDoStmt"; break;+  case AtomVariable:    return "AtomVariable"; break;+  case AtomConstructor: return "AtomConstructor"; break;+  case AtomAbstract:    return "AtomAbstract"; break;+  case ListCons:        return "ListCons"; break;++  case ANYEXP:  return "Exp"; break;+  case ANYATOM: return "Atom"; break;+  case HEADER:  return "HEADER/INVALID"; break; /* same for INVALID */+  case BEYOND:  return "beyond end of file";++  default:              return "unknown/unused"; break;+  }+}++char*+ref2str (int k)+{+  switch (k) {+  case Root:         return "Root"; break;+  case Unevaluated:  return "Unevaluated"; break;+  case Entered:      return "Entered"; break;+  case Interrupted:  return "Interrupted"; break;+  case Lambda:       return "Lambda"; break;+  case DoLambda:     return "DoLambda"; break;+  default:           return "Ref"; break;+  }+}+++/* Main driver and routines to provide basic interface to archive file.+ */++FILE* f;             /* file descriptor for archive */+uint32_t nextoffset=0;	/* current position in file */++int vmode = 0;       /* verify -- check tag-types of pointer destinations */+int smode = 0;       /* statistics -- counts and space usage for node types */+int amode = 0;       /* ascii -- show archive in a `readable' text format */+int gmode = 0;       /* graph -- generate source for dot graph-drawing */+int nmode = 0;       /* node -- show node at given offset in text format */+int rmode = 0;       /* reachable -- show how many nodes are reachable */+int xmode = 0;       /* exit mode -- cleanup after signal to halt */++unsigned filesize = 0; /* used in precondition for seeks ... */+struct stat statbuf;   /* ... to catch seek beyond EOF */++#define FILENAMESIZE 200+char filename[FILENAMESIZE];++/* byte buffer for use in reachability mark-phase */+#define BUFFERSIZE 100000+uint32_t buffer[BUFFERSIZE];++/* signal handler -- only installed for -r */+void+restoretags (int signum)+{+  fprintf(stderr, "hat-check cleaning up -- please wait\n");+  amode = 0; rmode = 0; smode = 0; vmode = 0;+  xmode = 1;+  fseek(f,0,SEEK_SET);+  nextoffset = 0;+  header();+  nodes();+  exit(1);+}++int+hat_check (int argc, char *argv[])+/* main (int argc, char *argv[]) */+{+  int i = 0;+  while (++i < argc-1) {+    if (strcmp(argv[i], "-v") == 0) {+      vmode = 1;+    } else if (strcmp(argv[i], "-s") == 0) {+      smode = 1;+    } else if (strcmp(argv[i], "-a") == 0) {+      amode = 1;+    } else if (strcmp(argv[i], "-g") == 0) {+      gmode = 1;+    } else if (strcmp(argv[i], "-n") == 0) {+      nmode = 1;+      sscanf(argv[++i], "0x%x", &nextoffset);      +    } else if (strcmp(argv[i], "-r") == 0) {+      smode = 1;+      rmode = 1;+    } else {+      badusage();+    }+  }+  if (i > argc-1) badusage();+  strcpy(filename, argv[i]);+  if (!strends(".hat", filename)) strcat(filename, ".hat");+  stat(filename, &statbuf);+  filesize = statbuf.st_size;+  f = fopen(filename, (rmode ? "r+b" : "rb"));+  if (f==(FILE*)0) {+    fprintf(stderr, "cannot open trace file %s\n",filename);+    exit(1);+  }++  /* version checking added by MW */+  { int err;+    char *header = (char*)malloc(10*sizeof(char));+    err = fread(header,sizeof(char),8,f);+    if (err!=8) {+      fprintf(stderr,"hat-check (error): file %s is too short\n",filename);+      exit(1);+    }+    if (strncmp(header,"Hat",3)) {+      fprintf(stderr,"hat-check (error): file %s\n",filename);+      fprintf(stderr,"   does not appear to be a Hat archive.  Quitting.\n");+      exit(1);+    }+    if (strncmp(header+3,FILEVERSION,4)) {+      fprintf(stderr,"hat-check (warning): file %s\n",filename);+      fprintf(stderr,"   appears to be a Hat archive in format %s\n",header+3);+      fprintf(stderr,"   but this tool deals with format version %s\n",FILEVERSION);+      fprintf(stderr,"   I'm continuing, but there may be unexpected errors.\n");+    }+    fseek(f,0,SEEK_SET);	/* reset to beginning of file */+    free(header);+  }++  printf("Hat archive has expected version %s.\n", FILEVERSION);++  if (nmode) {+    if (nextoffset >= filesize) {+      fprintf(stderr, "-n 0x%x is beyond end of trace file\n", nextoffset);+      exit(1);+    }+    amode = 1; rmode = 0; smode = 0;+  } else {+    nextoffset = 0L;+  }+  if (rmode) {+    signal(SIGINT, restoretags);+#ifdef SIGQUIT+    signal(SIGQUIT, restoretags);+#endif+    markfromheader(buffer);+    strcat(filename, ".bridge");+    markfromoutput(filename,buffer);+    fseek(f,0,SEEK_SET);+  }+  fseek(f,nextoffset,SEEK_SET);+  if (nmode) {+    nextnode();+  } else {+    if (smode) initstats();+    if (gmode) printf("digraph hat{\n");+    header();+    nodes();+    if (gmode) printf("}\n");+    if (amode && smode) putchar('\n');+    if (smode) reportstats();+  }+}++int+strends (char *e, char *s)+{+  int d = strlen(s) - strlen(e);+  return d>=0 && strcmp(s+d, e)==0;+}++void+badusage (void)+{+  fprintf(stderr,"usage: hat-check [-a] [-n <hexnode>][-r] [-s] [-v] prog-name\n");+  fprintf(stderr,"\t-a\tprint ascii text version of hat file\n");+  fprintf(stderr,"\t-g\tprint dot graph-drawing code\n");+  fprintf(stderr,"\t-n\tprint text for specified node only (disables -r, -s)\n");+  fprintf(stderr,"\t-r\tprint statistics about reachable nodes (implies -s)\n");+  fprintf(stderr,"\t-s\tprint statistics about frequency and size of nodes\n");+  fprintf(stderr,"\t-v\tverify tag types of pointer destinations\n");+  exit(1);+}++#define MAX_TAG 32+uint32_t count[MAX_TAG]; /* indexed by tag byte: Module, SrcPos, etc */+uint32_t space[MAX_TAG];/* ditto */+uint32_t headspace;     /* space oocupied by header */+uint32_t reachcount[MAX_TAG];++void+initstats (void)+{+  int k;+  for (k=0; k<MAX_TAG; k++) {+    count[k] = 0;+    reachcount[k] = 0;+    space[k] = 0L;+  }+}++float+pc (uint32_t i, uint32_t j)+{+  return (float)((i*100.0)/j);+}++void+reportstats (void)+{+  unsigned int grandcount = 1;+  unsigned int grandreachcount = 1;+  uint32_t grandspace = headspace;+  int k;+  for (k=0; k<MAX_TAG; k++) {+    grandcount += count[k];+    grandreachcount += reachcount[k];+    grandspace += space[k];+  }+  if (rmode) printf("%7s", "% Reach");+  printf("%10s   %-20s%12s%10s\n\n",+    "Number", "Description", "Bytes", "% Space");+  if (rmode) printf("%7.1f", pc(1,1));+  printf("%10u   %-20s%12u%10.1f\n",+    1, "header", headspace, pc(headspace,grandspace));+  for (k=0; k<=ListCons; (k==ExpDoStmt? k=AtomVariable: k++)) {+    if (rmode) printf("%7.1f", pc(reachcount[k], count[k]));+    printf("%10u   %-20s%12u%10.1f\n",+      count[k], tag2str(k), space[k],+      pc(space[k],grandspace));+  }+  { int w;+    putchar('\n');+    if (rmode) for (w=0; w<7; w++) putchar(' ');+    for (w=0; w<55; w++) putchar(w<13 ? ' ' : '-');+    putchar('\n');+  }+  if (rmode) printf("%7.1f", pc(grandreachcount,grandcount));+  printf("%10u   %-20s%12u%10.1f\n",+    grandcount, "whole trace file", grandspace, pc(grandspace,grandspace));+}++char+nextbyte (void)+{+  char c; int err;+  err = fread(&c,sizeof(char),1,f);+  nextoffset+=1;+  if (err!=1) {+    fflush(stdout);+    fprintf(stderr, "unexpected end of trace file at 0x%x\n",nextoffset);+    exit(1);+  }+  return c;+}++/* Routines to extract values encoded as one or more bytes.+ */++#define LARGEST_STRING 65536+char stringbuf[LARGEST_STRING];+/* readstring() reads a length-annotated string from the current position+ * in the file and stores it in a global buffer.+ */+char*+readstring (void)+{+  char *buf=stringbuf;+  int i, n;++  n = (int)fgetc(f);+  nextoffset+=1;+  if (n==0xff) {+    n = (int)fgetc(f);+    n = (n<<8) + (int)fgetc(f);+    nextoffset+=2;+  }+  i = fread(buf,sizeof(char),n,f);+  nextoffset+=i;+  buf[n] = '\0';+  if (i<n) {+    fprintf(stderr+           ,"hat-check: warning, only read %d characters of %d in string\n"+           ,i,n);+  }+  return buf;+}++typedef uint32_t fourbytes;++fourbytes+readfourbytes (void)+{+  int err;+  fourbytes slot;+  err = fread(&slot,sizeof(fourbytes),1,f);+  nextoffset+=4;+  if (err!=1) {+    fflush(stdout);+    fprintf(stderr, "unexpected end of trace file before 0x%x\n",nextoffset);+    fprintf(stderr, "actual file position is 0x%lx\n",ftell(f));+    exit(1);+  }+  return ntohl(slot);+}++#define POSNMAX 40+char posnbuf[POSNMAX+1];++char*+readposn (void)+{+  uint32_t begin = readfourbytes();+  uint32_t end = readfourbytes();+  sprintf(posnbuf, "position %u:%u-%u:%u,", +          begin/10000, begin%10000, end/10000, end%10000);+  return posnbuf;+}++uint32_t+readpointer (void)+{ return readfourbytes(); }++char+readchar (void)+{ return nextbyte(); }++int+readint (void)+{ return readfourbytes(); }++char*+readinteger (void)+{ return readstring(); }++char*+readrational (void)+{+  char *num, *denom;+  num = strdup(readinteger());+  denom = strdup(readinteger());+  strcpy(stringbuf,num);+  strcat(stringbuf,":%");+  strcat(stringbuf,denom);+  free(num); free (denom);+  return stringbuf;+}++float+readfloat (void)+{+  int err;+  float buf;+  err = fread(&buf,sizeof(float),1,f);+  nextoffset+=sizeof(float);+  if (err!=1) {+    fflush(stdout);+    fprintf(stderr, "unexpected end of trace file before 0x%x\n",nextoffset);+    fprintf(stderr, "actual file position is 0x%lx\n",ftell(f));+    fprintf(stderr, "while reading a float\n");+    exit(1);+  }+  return buf;+}++double+readdouble (void)+{+  int err;+  double buf;+  err = fread(&buf,sizeof(double),1,f);+  nextoffset+=sizeof(double);+  if (err!=1) {+    fflush(stdout);+    fprintf(stderr, "unexpected end of trace file before 0x%x\n",nextoffset);+    fprintf(stderr, "actual file position is 0x%lx\n",ftell(f));+    fprintf(stderr, "while reading a double\n");+    exit(1);+  }+  return buf;+}++int+lo5 (char b)+{ return (int)(b&0x1f); }++unsigned int+readarity (void)+{ return (unsigned int)(unsigned char)nextbyte(); }++#define FIXPRIMAX 10+char fixpribuf[FIXPRIMAX+1];++char*+readfixpri (void)+{+  int b = (int)(nextbyte());+  switch (b % 4) {+  case 0:+    sprintf(fixpribuf, " infix %d,", b/4);+    break;+  case 1:+    sprintf(fixpribuf, " infixr %d,", b/4);+    break;+  case 2:+    sprintf(fixpribuf, " infixl %d,", b/4);+    break;+  case 3:+    sprintf(fixpribuf, "");+    break;+  }+  return fixpribuf;+}++int+tagat (uint32_t offset)+{+  char byte[1];+  int i;+  if (offset <= filesize) {+    fseek(f, offset, SEEK_SET);+    i = fread(byte,sizeof(char),1,f);+    fseek(f, nextoffset, SEEK_SET);+    if (rmode) cleartag(byte);+    return (i==1 ? lo5(*byte) : INVALID);+  } else return BEYOND;+}++void+newtagat (char *t, uint32_t offset)+{+  fseek(f, offset, SEEK_SET);+  fwrite(t,sizeof(char),1,f);+  fseek(f, nextoffset, SEEK_SET);+}++++/* dopointer():+ * When checking for correctness (-v), there are several parameters to+ * take into account.+ *    okzero:   Is the pointer permitted to be root,unevaluated,error,lambda?+ *    requiretag:    What kind of node should the pointer point to?+ *    requireoffset: The pointer itself.+ *    contexttag:    What kind of node did the pointer come from?+ *    contextoffset: Where did the pointer come from?+ */+#define NONZERO 0+#define MAYBEZERO 1+#define MAYBELAMBDA 4+   +void+dopointer (int okzero,+           int requiretag, uint32_t requireoffset,+           int contexttag, uint32_t contextoffset,+	   char *edgelabel)+{+  if (vmode && ((okzero==NONZERO && requireoffset <= Interrupted)+               || (okzero==MAYBELAMBDA && requireoffset < Lambda))) {+      fprintf(stderr, "bad %s pointer in %s 0x%x\n"+             ,ref2str(requireoffset), tag2str(contexttag), contextoffset);     +  }+  if (vmode && requireoffset>DoLambda) {+    int t = tagat(requireoffset);+    if (t != requiretag) {+      if ((requiretag==ANYEXP) && (ExpApp<=t) && (t<=ExpDoStmt))+        ;+      else if ((requiretag==ANYATOM) && (AtomVariable<=t) && (t<=AtomAbstract))+        ;+      else fprintf(stderr, "tag at 0x%x is %s, not %s as %s at 0x%x implies\n"+                         , requireoffset, tag2str(t), tag2str(requiretag)+	                 , tag2str(contexttag), contextoffset);+    }+  }+  if (amode) {+    switch(requireoffset) {+      case Root:+      case Unevaluated:+      case Entered:+      case Interrupted:+      case Lambda:+      case DoLambda:+                printf("(%s)",ref2str(requireoffset));+                break;+      default:  printf("(%s 0x%x)", tag2str(requiretag), requireoffset);+                break;+    }+  }+  if (gmode && requireoffset!=0 && *edgelabel != '\0')+    if (strcmp(edgelabel,"p")==0)+      printf("%d -> %d [style=dashed]\n",+        contextoffset, requireoffset);+    else+      printf("%d -> %d [label=\"%s\"]\n",+        contextoffset, requireoffset, edgelabel);+}+  +#define ismarked(b) ((b)&0x80)++void+marktag (char *b)+{ *b |= 0x80; }++void+cleartag (char *b)+{ *b &= 0x7F; }++/* reading, checking and/or writing header and node information+ */+ +void+header (void)+{+  char s[9];+  fread(s,sizeof(char),8,f); s[8]='\0';+  nextoffset = 8;+  if (amode) printf("%s", s);+  if (amode) printf("\nEntry point: ");+  dopointer(MAYBEZERO, ANYEXP, readpointer(), HEADER, 0L, "");+  if (amode) printf("\nError message: ");+  dopointer(MAYBEZERO, AtomAbstract, readpointer(), HEADER, 0L, "");+  if (amode) printf("\n");+  headspace = nextoffset;+}++void+nodes (void)+{ +  while (!feof(f)) { nextnode(); }+}++void+nextnode (void)+{+  uint32_t offset = nextoffset;+  char b;+  int marked, err;+  err = fread(&b,sizeof(char),1,f); nextoffset+=1;+  if (err!=1) return;+  if (rmode || xmode) {+    marked = ismarked(b);+    if (marked) {+      cleartag(&b);+      newtagat(&b, offset);+    }+    if (amode) printf("%s", (marked ? "=> " : "   "));+  }+  {+    int k = lo5(b);+    if ((ExpDoStmt<k && k<AtomVariable) || k>ListCons) {+      fprintf(stderr, "strange tag %d at byte offset 0x%x\n",+                      k, offset);+      exit(1);+    } else if (smode) {+      count[k]++;+      if (rmode && marked) reachcount[k]++;+    }+    switch (k) {+    case ListCons:+	if (gmode) printf("%d [label=\"0x%x ListCons\"]\n", offset, offset);+        if (amode) printf("0x%x:  %-20s\t", offset, tag2str(k));+	if (amode) printf("elem=");+        dopointer(NONZERO, ANYEXP, readpointer(), k, offset, "e");+	if (amode) printf(" tail=");+        dopointer(MAYBEZERO, ListCons, readpointer(), k, offset, "t");+      break;+    case Module:+      if (amode) {+        if (tracedModule(b))+             printf("0x%x:  Module (suspect) \t", offset);+        else printf("0x%x:  Module (trusted) \t", offset);+      }+      { char *s = readstring(); if (amode) printf("%s\t", s); }+      { char *s = readstring(); if (amode) printf("\"%s\"", s); }+      break;+    case SrcPos:+      if (amode) printf("0x%x:  SrcPos\t\t\t", offset);+      dopointer(NONZERO, Module, readpointer(), k, offset, "");+      { char *p = readposn(); if (amode) printf(" %s", p); }+      break;+    case AtomVariable:+      if (amode) {+        if (localDef(b))+             printf("0x%x:  AtomVariable (local)\t", offset);+        else printf("0x%x:  AtomVariable (toplevel)\t", offset);+      }+      if (gmode) printf("%d [label=\"0x%x AtomVariable", offset, offset);+      dopointer(NONZERO, Module, readpointer(), k, offset, "");+      { char *p = readposn(); if (amode) printf(" %s", p); }+      { char *fp = readfixpri(); if (*fp!='\0' && amode) printf("%s ", fp); }+      { unsigned int a = readarity();+        if (amode || gmode) printf(amode ? " arity=%u," : " %u", a); }+      { char *n = readstring(); if (amode || gmode) printf(" %s", n); }+      if (gmode) printf("\"]\n");+      break;+    case AtomConstructor:+      if (amode) printf("0x%x:  %-20s\t", offset, tag2str(k));+      if (gmode) printf("%d [label=\"0x%x AtomConstructor", offset, offset);+      dopointer(NONZERO, Module, readpointer(), k, offset, "");+      { char *p = readposn(); if (amode) printf(" %s", p); }+      { char *fp = readfixpri(); if (*fp!='\0' && amode) printf("%s", fp); }+      { unsigned int a = readarity();+        if (amode || gmode) printf(amode ? " arity=%u," : " %u", a);+        { char *n = readstring(); if (amode || gmode) printf(" %s", n); }+        if (gmode) printf("\"]\n");+        if hasFields(b) {+	  int i;+          if (amode) printf(" fields:");+          for (i=1; i<=a; i++) {+            dopointer(NONZERO, AtomVariable, readpointer(), k, offset,+	      (gmode ? (sprintf(stringbuf,"%d",i), stringbuf) : "")+	    );+          }+        }+      }+      break;+    case AtomAbstract:+      if (amode) printf("0x%x:  %-20s\t", offset, tag2str(k));+      if (gmode) printf("%d [label=\"0x%x AtomAbstract ", offset, offset);+      { char *s = readstring(); if (amode || gmode) printf("%s", s); }+      if (gmode) printf("\"]\n");+      break;+    default: {+      if (amode) printf("0x%x:  %-20s\t", offset, tag2str(k));+      if (hasSrcPos(b)) {+	  if (amode) printf("use=");+          dopointer(NONZERO, SrcPos, readpointer(), k, offset, "");+	  if (amode) printf(" ");+      }+   // if (amode && (ExpChar <= k) && (k <= ExpConstUse)) {+   //     printf("(");+   //     if (!isEntered(b)) printf("not ");+   //     printf("entered) ");+   // }+      switch (k) {+      case ExpApp:+	if (amode) printf("parent=");+        dopointer(MAYBEZERO, ANYEXP, readpointer(), k, offset, "p");+	if (amode) printf(" result=");+        dopointer(MAYBEZERO, ANYEXP, readpointer(), k, offset, "r");+	if (amode) printf(" fun=");+        dopointer(NONZERO, ANYEXP, readpointer(), k, offset, "f");+        if (gmode) printf("%d [label=\"0x%x ExpApp", offset, offset);+        { unsigned int a = readarity();+	  int i;+	  if (amode || gmode)+	    printf(amode ? " arity=%u, args " : " %u\"]\n",a);+	  for (i=1; i<=a; i++)+	    dopointer(NONZERO, ANYEXP, readpointer(), k, offset,+	      (gmode ? (sprintf(stringbuf,"%d",i), stringbuf) : "")+	    );+	}+	break;+      case ExpValueApp:+	if (amode) printf("parent=");+        dopointer(MAYBEZERO, ANYEXP, readpointer(), k, offset, "p");+	if (amode) printf(" fun=");+        dopointer(NONZERO, ANYATOM, readpointer(), k, offset, "f");+        if (gmode) printf("%d [label=\"0x%x ExpValueApp", offset, offset);+        { unsigned int a = readarity();+	  int i;+	  if (amode || gmode)+	    printf(amode ? " arity=%u, args " : " %u\"]\n",a);+	  for (i=1; i<=a; i++)+	    dopointer(NONZERO, ANYEXP, readpointer(), k, offset,+	      (gmode ? (sprintf(stringbuf,"%d",i), stringbuf) : "")+	    );+	}+	break;+      case ExpChar:+	if (amode) printf("parent=");+        dopointer(MAYBEZERO, ANYEXP, readpointer(), k, offset, "p");+        { char c = nextbyte();+	  if (gmode) printf("%d [label=\"ExpChar", offset);+	  if (amode || gmode) printf(" '%c'", c);+	  if (gmode) printf("\"]\n");+	}+	break;+      case ExpInt:+	if (amode) printf("parent=");+        dopointer(MAYBEZERO, ANYEXP, readpointer(), k, offset, "p");+        { int i; i = readfourbytes();+	  if (gmode) printf("%d [label=\"ExpInt", offset);+	  if (amode || gmode) printf(" %d", i);+	  if (gmode) printf("\"]\n");+	}+	break;+      case ExpInteger:+	if (amode) printf("parent=");+        dopointer(MAYBEZERO, ANYEXP, readpointer(), k, offset, "p");+        { char* i; i = readinteger();+	  if (gmode) printf("%d [label=\"ExpInteger", offset);+	  if (amode || gmode) printf(" %s", i);+	  if (gmode) printf("\"]\n");+	}+	break;+      case ExpRat:+	if (amode) printf("parent=");+        dopointer(MAYBEZERO, ANYEXP, readpointer(), k, offset, "p");+        { int n,d; n=readfourbytes(); d=readfourbytes();+	  if (gmode) printf("%d [label=\"ExpRat", offset);+          if (amode || gmode) printf(" %d%%%d", n,d);+	  if (gmode) printf("\"]\n");+        }+	break;+      case ExpRational:+	if (amode) printf("parent=");+        dopointer(MAYBEZERO, ANYEXP, readpointer(), k, offset, "p");+        { char* r = readrational();+	  if (gmode) printf("%d [label=\"ExpRational", offset);+	  if (amode || gmode) printf(" %s", r);+	  if (gmode) printf("\"]\n");+        }+	break;+      case ExpFloat:+	if (amode) printf("parent=");+        dopointer(MAYBEZERO, ANYEXP, readpointer(), k, offset, "p");+        { float f = readfloat();+	  if (gmode) printf("%d [label=\"ExpFloat", offset);+	  if (amode || gmode) printf(" %f", f);+	  if (gmode) printf("\"]\n");+        }+	break;+      case ExpDouble:+	if (amode) printf("parent=");+        dopointer(MAYBEZERO, ANYEXP, readpointer(), k, offset, "p");+        { double d = readdouble();+	  if (gmode) printf("%d [label=\"ExpDouble", offset);+	  if (amode || gmode) printf(" %f", d);+	  if (gmode) printf("\"]\n");+        }+	break;+      case ExpValueUse:+	if (gmode) printf("%d [label=\"0x%x ExpValueUse\"]\n", offset, offset);+	if (amode) printf("parent=");+        dopointer(MAYBEZERO, ANYEXP, readpointer(), k, offset, "p");+	if (amode) printf(" value=");+        dopointer(MAYBELAMBDA, ANYATOM, readpointer(), ExpValueUse, offset,"v");+	break;+      case ExpConstUse:+	if (gmode) printf("%d [label=\"0x%x ExpConstUse\"]\n", offset, offset);+	if (amode) printf("parent=");+        dopointer(MAYBEZERO, ANYEXP, readpointer(), k, offset, "p");+	if (amode) printf(" const=");+        dopointer(NONZERO, ExpConstDef, readpointer(), k, offset, "c");+	break;+      case ExpConstDef:+	if (gmode) printf("%d [label=\"0x%x ExpConstDef\"]\n", offset, offset);+	if (amode) printf("parent=");+        dopointer(MAYBEZERO, ANYEXP, readpointer(), k, offset, "p");+	if (amode) printf(" result=");+        dopointer(MAYBEZERO, ANYEXP, readpointer(), k, offset, "r");+	if (amode) printf(" var=");+        dopointer(NONZERO, AtomVariable, readpointer(), k, offset, "v");+	break;+      case ExpGuard:+      case ExpCase:+      case ExpIf:+	if (gmode) printf("%d [label=\"0x%x %s\"]\n", offset, offset,+                  k==ExpGuard ? "ExpGuard" : k==ExpCase ? "ExpCase" : "ExpIf");+	if (amode) printf("parent=");+        dopointer(MAYBEZERO, ANYEXP, readpointer(), k, offset, "p");+	if (amode) printf(" result=");+        dopointer(MAYBEZERO, ANYEXP, readpointer(), k, offset, "r");+	if (amode) printf(" cond=");+        dopointer(NONZERO, ANYEXP, readpointer(), k, offset, "c");+	break;+      case ExpFieldUpdate:+	if (amode) printf("parent=");+        dopointer(MAYBEZERO, ANYEXP, readpointer(), k, offset, "p");+	if (amode) printf(" result=");+        dopointer(MAYBEZERO, ANYEXP, readpointer(), k, offset, "r");+	if (amode) printf(" arg=");+        dopointer(NONZERO, ANYEXP, readpointer(), k, offset, "a");+        { unsigned int i, arity = readarity();+	  if (gmode) printf("%d [label=\"0x%x ExpFieldUpdate %u\"]\n", offset, offset, arity);+	  if (amode) printf(" arity=%u, binders ",arity);+          for (i=0; i<arity; i++) {+            dopointer(NONZERO, AtomVariable, readpointer(), k, offset, "");+          }+	  if (amode) printf(", bindees ",arity);+          for (i=0; i<arity; i++) {+            dopointer(NONZERO, ANYEXP, readpointer(), k, offset, "");+          }+        }+	break;+      case ExpProjection:+	if (gmode) printf("%d [label=\"0x%x ExpProjection\"]\n", offset, offset);+	if (amode) printf("parent=");+        dopointer(MAYBEZERO, ANYEXP, readpointer(), k, offset, "p");+	if (amode) printf(" exp=");+        dopointer(NONZERO, ANYEXP, readpointer(), k, offset, "e");+	break;+      case ExpHidden:+	if (gmode) printf("%d [label=\"0x%x ExpHidden\"]\n", offset, offset);+	if (amode) printf("parent=");+        dopointer(MAYBEZERO, ANYEXP, readpointer(), k, offset, "p");+	if (amode) printf(" result=");+        dopointer(MAYBEZERO, ANYEXP, readpointer(), k, offset, "r");+	if (amode) printf(" children=");+	dopointer(MAYBEZERO, ListCons, readpointer(), k, offset, "c");+	break;+      case ExpForward:+	if (gmode) printf("%d [label=\"0x%x ExpForward\"]\n", offset, offset);+	if (amode) printf("result=");+        dopointer(NONZERO, ANYEXP, readpointer(), k, offset, "r");+	break;+      case ExpDoStmt:+	if (gmode) printf("%d [label=\"0x%x ExpDoStmt\"]\n", offset, offset);+	if (amode) printf("stmt=");+        dopointer(NONZERO, ANYEXP, readpointer(), k, offset, "s");+	break;+      }+    }}+    if (amode) printf("\n");+    if (smode) space[k] += nextoffset - offset;+  }+}+++/* Traverse the trail structure starting from output and error+ * roots, marking all reachable nodes.+ */+uint32_t+getpointer (uint32_t *buf)+{  return ntohl(*buf); }++/* reading, checking and/or writing header and node information+ */+void+markfromheader (uint32_t *buf)+{+  fseek(f,8L,SEEK_SET);+  fread(buf,sizeof(uint32_t),2,f);+  markfrom(getpointer(buf+1),buf+1);+  markfrom(getpointer(buf),  buf);+}++void+markfromoutput (char *bridgefile, uint32_t *buf)+{+  FILE* bridge = fopen(bridgefile, "rb");+  if (bridge==(FILE*)0) return;+  for (;;) {+    int n = fread(buf,sizeof(uint32_t),1,bridge);+    if (n<1) return;+    markfrom(getpointer(buf),buf);+  }+  fclose(bridge);+}++/* mark all the nodes in the hat file that are reachable+ * from the given root -- setting the highest bit in the+ * tag byte+ */+void+markfrom (uint32_t root, uint32_t *buf)+{+  char tag;+  if (root > 8 && root < filesize) {+    /* First read the tag byte.  If it is marked, return.+     * If it is not marked, then mark it now.+     */+    fseek(f,root,SEEK_SET);+    fread(&tag,sizeof(char),1,f);+    if (ismarked(tag)) return;+    marktag(&tag);+    fseek(f,root,SEEK_SET);+    fwrite(&tag,sizeof(char),1,f);+    cleartag(&tag);+    /* Examine the tag to determine the kind of node.+     * Read pointers from the node into buf, then+     * markfrom() these pointers recursively.  The buffer is+     * overwritten where possible to minimise the risk of overflow:+     * for this reason, pointers are recursively traced in+     * reverse order.+     */+    {+      int k = lo5(tag);+      if ((ExpDoStmt < k && k < AtomVariable) || k > ListCons) {+	fprintf(stderr, "strange tag %d at 0x%x\n",+                	k, root);+	exit(1);+      }+      switch (k) {+        case ListCons:+          fread(buf,sizeof(uint32_t),2,f);	/* two pointers */+          markfrom(getpointer(buf+1),buf+1);+          markfrom(getpointer(buf),buf);+	  break;+        case Module: break;+        case AtomAbstract: break;++        case SrcPos:+        case AtomVariable:+        case AtomConstructor: 	/* ignore fieldnames for now */+          fread(buf,sizeof(uint32_t),1,f);	/* points to module mode */+          markfrom(getpointer(buf),buf);+          break;++        default: {+          int pos = 0;+          if (hasSrcPos(tag)) {+            fread(buf+pos,sizeof(uint32_t),1,f);+            pos++;+          }+          fread(buf+pos,sizeof(uint32_t),1,f);	/* parent pointer */+          pos++;+          switch (k) {+            case ExpApp:+              fread(buf+pos,sizeof(uint32_t),2,f); /* result+fun */+              pos += 2;+              { unsigned char arity;+                fread(&arity,sizeof(unsigned char),1,f);+                fread(buf+pos,sizeof(uint32_t),(unsigned int)arity,f);+                pos += (int)arity;+              }+	      break;+            case ExpValueApp:+              fread(buf+pos,sizeof(uint32_t),1,f); /* fun */+              pos += 1;+              { unsigned char arity;+                fread(&arity,sizeof(unsigned char),1,f);+                fread(buf+pos,sizeof(uint32_t),(unsigned int)arity,f);+                pos += (int)arity;+              }+	      break;+            case ExpValueUse:+            case ExpConstUse:+            case ExpProjection:+              fread(buf+pos,sizeof(uint32_t),1,f);	/* one extra pointer */+              pos++;+	      break;+            case ExpHidden:+            case ExpConstDef:+            case ExpFieldUpdate:	/* ignore fieldnames for now */+            case ExpGuard:+            case ExpCase:+            case ExpIf:+              fread(buf+pos,sizeof(uint32_t),2,f);	/* two pointers */+              pos+=2;+	      break;+            default: break;				/* no pointers */+          }+	  for (;pos-->0;) markfrom(getpointer(buf+pos), buf+pos);+        } break;+      }+    }+  }+}++
+ tools/hat-names.c view
@@ -0,0 +1,586 @@+/* This is an implementation of a linear search through the .hat file,+ * building a list of all identifiers found, with application counts.+ */+#include <unistd.h>+#include <stdlib.h>+#include <stdio.h>+#include <string.h>+#include <errno.h>+#include <sys/stat.h>+#include "finitemap.h"+#include "pathutils.h"+#include "art.h"+#include "artutils.h"+#include "hat-names.h"++#define DEBUG 0+#if DEBUG+#define HIDE(x) x+#else+#define HIDE(x)+#endif++/* What we eventually end up with is three flat arrays of information, one for+ * each of globals fns, local fns, and constructors.  These can be passed+ * en masse back to Haskell land for screen presentation.+ */+item **Globals, **Locals, **Constrs;+int GlobalsIdx=0, LocalsIdx=0, ConstrsIdx=0;++/* Return the data to Haskell-land */+FileOffset itemIdent   (item* i) { return i->thispos; }+int        itemArity   (item* i) { return (int)i->arity; }+int        itemUses    (item* i) { return i->uses; }+int        itemPending (item* i) { return i->pending; }+int        itemThunks  (item* i) { return i->thunks; }+item*      getItemPtr  (item **arr, int n) { return arr[n]; }+item**     getGlobals  (void)    { return Globals; }+item**     getLocals   (void)    { return Locals; }+item**     getConstrs  (void)    { return Constrs; }+int        getGlobalsN (void)    { return GlobalsIdx; }+int        getLocalsN  (void)    { return LocalsIdx; }+int        getConstrsN (void)    { return ConstrsIdx; }+++/* There are two finitemap structures that associate file pointers+ * with items.+ *+ * The first maps an AtomVariable or AtomConstructor pointer+ * to the information (struct item) we are interested in.+ *+ * The second maps an ExpValueUse, ExpConstUse, or ExpConstDef pointer+ * to the Atom pointer it contains (struct defn).  It also maps any+ * undersaturated application (ExpApp) to the Atom pointer.  The (struct+ * defn) contains a note of the remaining arity so we can tell when full+ * saturation is reached.+ *+ * In the second map, each atom might be the target of several+ * trace pointers, e.g. different usage sites in the source lead to+ * different ExpValueUse nodes, each pointing to the same Atom;+ * e.g.2. an undersaturated ExpApp node (partial application) can+ * also map to an Atom.+ *+ * When searching, when we find:+ *      an Atom -> add it to the first map+ *      an ExpValueUse -> add it to the second map (no increment)+ *      an ExpConstDef -> add it to the second map (no increment)+ *      an ExpConstUse -> add it to the second map (increment item)+ *      an ExpApp -> check arity, if saturated, just increment item+ *                                otherwise add to 2nd map (no increment)+ */+FiniteMap map1, map2 /*, globals=0, locals=0, constrs=0*/ ;+void+map1_insert (FileOffset node, char* id, idkind k, unsigned char arity)+{+  item *it = (item*)0;+  it = FM_lookup(map1,(cast)node);+  if (!it) {+    it = (item*)malloc(sizeof(item));+    it->name  = id;+    it->kind  = k;+    it->arity = arity;+    it->uses    = 0;+    it->pending = 0;+    it->thunks  = 0;+    it->thispos = node;+    FM_insert(map1,(cast)node,(cast)it);+  }+}+defn*+map2_insert (FileOffset usage, FileOffset def, unsigned char ap)+{+  item *it = (item*)0;+  it = FM_lookup(map1,(cast)def);+  if (it) {+    defn *fn;+    fn = (defn*)malloc(sizeof(defn));+    fn->atom  = def;+    fn->arity = it->arity - ap;+    fn->next  = (defn*)0;+  //if (strcmp(it->name,">=")==0)+  //  fprintf(stderr,"map2: %s at 0x%x (%d)\n",it->name,usage,it->uses);+    FM_insert(map2,(cast)usage,(cast)fn);+    return fn;+  } else return (defn*)0;+}++#if 0+/* item_sort() doesn't do any sorting at all.  It folds one item of+ * information into one of three new finite maps (globals,locals,constrs).+ * The new maps are indexed by name rather than file position - if the+ * name is new, a new entry is created; if it exists already, the counts+ * are added together.+ */+int+item_sort (FileOffset node, item *it, void* dummy)+{+  item *already;+  switch (it->kind) {+    case TopId:+      already = FM_lookup(globals,(cast)it->name);+      if (already) {+        it->uses += already->uses;+        it->pending += already->pending;+        it->thunks  += already->thunks;+      } else+        FM_insert(globals,(cast)it->name,(cast)it);+      break;+    case LocalId:+      already = FM_lookup(locals,(cast)it->name);+      if (already) {+        it->uses += already->uses;+        it->pending += already->pending;+        it->thunks  += already->thunks;+      } else+        FM_insert(locals, (cast)it->name,(cast)it);+      break;+    case Construct:+      already = FM_lookup(constrs,(cast)it->name);+      if (already) {+        it->uses += already->uses;+        it->pending += already->pending;+        it->thunks  += already->thunks;+      } else+        FM_insert(constrs,(cast)it->name,(cast)it);+      break;+    default: break;+  }+  return False;+}+#endif++/* item_flatten() takes one item of information in the finite map (map1)+ * and places it into the appropriate flat array (Globals,Local,Constrs).+ */+int+item_flatten (FileOffset node, item *it, void* dummy)+{+  static int globalsz=64, localsz=64, constrsz=64;+  switch (it->kind) {+    case TopId:+      if (GlobalsIdx==0)+          Globals = (item**)malloc(globalsz*sizeof(item*));+      if (GlobalsIdx==globalsz) {+          globalsz *= 2;+          Globals = (item**)realloc(Globals,globalsz*sizeof(item*));+      }+      Globals[GlobalsIdx++] = it;+      break;+    case LocalId:+      if (LocalsIdx==0)+          Locals = (item**)malloc(localsz*sizeof(item*));+      if (LocalsIdx==localsz) {+          localsz *= 2;+          Locals = (item**)realloc(Locals,localsz*sizeof(item*));+      }+      Locals[LocalsIdx++] = it;+      break;+    case Construct:+      if (ConstrsIdx==0)+          Constrs = (item**)malloc(constrsz*sizeof(item*));+      if (ConstrsIdx==constrsz) {+          constrsz *= 2;+          Constrs = (item**)realloc(Constrs,constrsz*sizeof(item*));+      }+      Constrs[ConstrsIdx++] = it;+      break;+    default: break;+  }+  return False;+}++#if 0+/* For printing the variable list with application counts, we need to+ * establish the longest name and the largest count, then columnate+ * the whole list.+ */+#define MAX_IDENT 1024+char	*idents[MAX_IDENT],    *counts[MAX_IDENT];+int	ident_size[MAX_IDENT], count_size[MAX_IDENT];+int	ident_index=0;++int+item_print (char *name, item *it, void* dummy)+{+  if (it->uses || it->pending) {+    if (ident_index >= MAX_IDENT) {+      fprintf(stderr,"out of space for identifiers\n");+      return True;+    }+    idents[ident_index] = name;+    ident_size[ident_index] = strlen(name);+    counts[ident_index] = (char*)malloc(35);+    if (it->pending) {+      snprintf(counts[ident_index],34,"[1;31m%d+[0m[34m%d"+              ,it->pending,it->uses);+      count_size[ident_index] = strlen(counts[ident_index]) - 16;+    } else {+      snprintf(counts[ident_index],34,"%d",it->uses);+      count_size[ident_index] = strlen(counts[ident_index]);+    }+    ident_index++;+  }+  return False;+}+void+columnate (int width)+{+  int i, j, max_count=0, max_ident=0, column_width, columns, lines, me;+  for (i=0; i<ident_index; i++) {+    if (count_size[i] > max_count) max_count=count_size[i];+    if (ident_size[i] > max_ident) max_ident=ident_size[i];+  }+  column_width = max_count + max_ident + 4;+  columns = width / column_width;+  if (ident_index % columns)+       lines = ident_index / columns + 1;+  else lines = ident_index / columns;+  for (i=0; i<lines; i++) {+    for (j=0; j<columns; j++) {+      me = j*lines + i;+      if (me < ident_index) {+        fprintf(stdout,"[34m%*s[0m %-*s"+                      ,max_count,counts[me],max_ident+3,idents[me]);+      }+    }+    fprintf(stdout,"\n");+  }+}++/* (Previously) The main routine called from Haskell.  It gathers+ * all information about identifiers from the file and pretty-prints+ * the data in columns.+ */+void+observableInfo (int width)+{+  int err;++  if (!Globals) {+    fprintf(stdout,"Searching...\n");++    q_position = 0x10;+    fseek(HatFileSeq,q_position,SEEK_SET);++    map1 = FM_new((FMComparison)fileoffset_compare,0);+    map2 = FM_new((FMComparison)fileoffset_compare,0);+    do {+      q_oneNode();+    } while (!feof(HatFileSeq));++    globals = FM_new((FMComparison)strcmp,0);+    locals  = FM_new((FMComparison)strcmp,0);+    constrs = FM_new((FMComparison)strcmp,0);+    FM_traverse(map1,(FMTraversal)item_sort,InOrder);++    FM_traverse(globals,(FMTraversal)item_print,InOrder);+    fprintf(stdout,"[A[K");	/* cursor up and clear-to-eol */+  }++  columnate(width);+  /* note: some data-structure clean-up needed? */+}+#endif++/* The (new) main routine called from Haskell.  It gathers all the+ * counts for identifiers from the file, and dumps the data into+ * global arrays.  Haskell has to get the individual records separately+ * afterwards.+ */+void+collateIdents (void)+{+  q_position = 0x10;+  fseek(HatFileSeq,q_position,SEEK_SET);++  map1 = FM_new((FMComparison)fileoffset_compare,0);+  map2 = FM_new((FMComparison)fileoffset_compare,0);+  do {+    q_oneNode();+  } while (!feof(HatFileSeq));+  FM_traverse(map1,(FMTraversal)item_flatten,InOrder);+//FM_destroy(map1);+//FM_destroy(map2);+}+++/* q_oneNode() moves the file pointer past a single node in the file.+ * As a side-effect, if it finds an AtomVariable or AtomConstructor,+ * it adds it to the global structure 'map1'.  If it finds an ExpValueUse+ * or ExpConstDef, it adds an entry in map2 from that usage to the relevant+ * Atom in map1.  If it finds an ExpApp or ExpConstUse, it instead looks+ * up the Atom ptr in map2, then looks up that Atom in map1, and finally+ * increments the usage counter.  However, in the case where an ExpApp+ * is undersaturated (discovered by comparing its arity with the arity+ * stored in map2), rather than incrementing the usage counter, we+ * instead need to add the address of the ExpApp to map2.+ */+void+q_oneNode (void)+{+  char c; int err;+  FileOffset node = q_position;+/*fprintf(stdout,"\n0x%x: ",position); fflush(stdout);*/+  err = q_fread(&c,sizeof(char),1,HatFileSeq);+  if (err!=1) return;+  switch (lower5(c)) {	/* lower 5 bits identify the TraceType */+    case ExpApp:+        if (hasSrcPos(c)) { q_readFO(); }+        q_readFO();		/* skip parent */+        { unsigned char size, next, i;+          FileOffset fun, result; defn *def; item *it;+          result = q_readFO();	/* get result */+          fun = q_readFO();	/* keep fun ptr */+          q_fread(&size,sizeof(unsigned char),1,HatFileSeq);	/* get arity */+          for (i=0; i<size; i++) q_readFO();	/* skip args */+          def = (defn*)FM_lookup(map2,(cast)fun);+          if (def) {+            defn *def2;+            it = FM_lookup(map1,(cast)def->atom);+            if (it) {+              if (size>=def->arity) {+                if (result==Entered) it->pending += 1;+                else if (result==Unevaluated) it->thunks += 1;+                else it->uses += 1;+              } else if (size < def->arity)+                def2 = map2_insert(node,def->atom,size);+            } else {+              fprintf(stderr,"unknown atom in fun at (ExpApp 0x%x)\n",node);+            }+            if (def->next) {+              it = FM_lookup(map1,(cast)def->next->atom);+              if (it) {+                if (size>=def->next->arity) {+                  if (result==Entered) it->pending += 1;+                  else if (result==Unevaluated) it->thunks += 1;+                  else it->uses += 1;+                } else if (size < def->next->arity) {+                  def2->next = (defn*)malloc(sizeof(defn));+                  def2->next->atom  = def->next->atom;+                  def2->next->arity = def->next->arity - size;+                  def2->next->next  = (defn*)0;+                }+              } else {+                fprintf(stderr,"unknown atom in CAF fun at (ExpApp 0x%x)\n",node);+              }+            }+          } else {+       //   fprintf(stderr,"unknown fun at (ExpApp 0x%x)\n",node); +          }+        } break;+    case ExpValueApp:+        if (hasSrcPos(c)) { q_readFO(); }+        q_readFO();		/* skip parent */+        { unsigned char size, next, i;+          FileOffset fun; defn *def; item *it;+          fun = q_readFO();	/* fun ptr is an Atom ref */+          q_fread(&size,sizeof(unsigned char),1,HatFileSeq);	/* get arity */+          for (i=0; i<size; i++) q_readFO();	/* skip args */+          it = FM_lookup(map1,(cast)fun);+          if (it) {+            if (size>=it->arity) {+              it->uses += 1;+              HIDE(fprintf(stderr,"0x%x ExpValueApp: incrementing\n",node);)+            } else if (size < it->arity) {+              map2_insert(node,fun,size);+              HIDE(fprintf(stderr,"0x%x ExpValueApp: partial app\n",node);)+            }+          } else {+            fprintf(stderr,"unknown atom in fun at (ExpValueApp 0x%x)\n",node);+          }+        } break;+    case ExpValueUse:+        if (hasSrcPos(c)) { q_readFO(); }+        q_readFO();		/* skip parent */+        { FileOffset atom; item *it;+          atom = q_readFO();	/* get atom */+          if ((atom!=Lambda)&&(atom!=DoLambda)) {+            it = FM_lookup(map1,(cast)atom);+            if (it) {+              map2_insert(node,atom,0);+              if ((it->kind==Construct) && (it->arity==0)) it->uses+=1;+            } else fprintf(stderr,"unknown atom in (ExpValueUse 0x%x)\n",node);+          }+        } break;+    case ExpConstUse:+        if (hasSrcPos(c)) { q_readFO(); }+        q_readFO();		/* skip parent */+        { FileOffset exp; defn *def; item *it;+          exp = q_readFO();	/* get ExpConstDef location */+          def = FM_lookup(map2,(cast)exp);+          if (def) {+            defn *def2;+            def2 = map2_insert(node,def->atom,0);+            it = FM_lookup(map1,(cast)def->atom);+            if (it) it->uses+=1;+            else fprintf(stderr+                        ,"unknown atom in defn in (ExpConstUse 0x%x)\n",node);+            if (def->next) {+              def2->next = def->next;+            }+          } // else fprintf(stderr,"unknown defn in (ExpConstUse 0x%x)\n",node);+        } break;+    case ExpConstDef:+        { FileOffset atom, result; item *it; defn *def;+          q_readFO();		/* skip parent */+          result = q_readFO();	/* result might be significant */+          atom = q_readFO();	/* get atom */+          it = FM_lookup(map1,(cast)atom);+          if (it) def = map2_insert(node,atom,0);+          else fprintf(stderr,"unknown atom in (ExpConstDef 0x%x)\n",node);+          countCAFResult(node,result,def,0,0);+        } break;+    case AtomVariable:+        q_readFO();	/* skip module pointer */+        { int x; q_fread(&x,sizeof(int),1,HatFileSeq); } /* skip line/col */+        { int x; q_fread(&x,sizeof(int),1,HatFileSeq); } /* skip line/col */+        { char x; q_fread(&x,sizeof(char),1,HatFileSeq); } /* skip fixity */+        { unsigned char arity; char *id; idkind k;+          q_fread(&arity,sizeof(unsigned char),1,HatFileSeq);+          id = q_readString();+          k = (localDef(c) ? LocalId : TopId);+          map1_insert(node,id,k,arity);+        }+        break;+    case AtomConstructor:+        q_readFO();	/* skip module pointer */+        { int x; q_fread(&x,sizeof(int),1,HatFileSeq); } /* skip line/col */+        { int x; q_fread(&x,sizeof(int),1,HatFileSeq); } /* skip line/col */+        { char x; q_fread(&x,sizeof(char),1,HatFileSeq); } /* skip fixity */+        { unsigned char arity, tmp; char *id;+          q_fread(&arity,sizeof(unsigned char),1,HatFileSeq);+          id = q_readString();+          if (hasFields(c)) for (tmp=arity;tmp-->0;) q_readFO();+          HIDE(fprintf(stderr,"0x%x AtomConstructor: found %s\n",node,id);)+          map1_insert(node,id,Construct,arity);+        }+        break;+    case AtomAbstract:+        { char* id;+          id = q_readString();+          map1_insert(node,id,Construct,0);+        }+        break;+    default:+        q_skipNode(c);+        break;+  }+}++void+countCAFResult (FileOffset caf, FileOffset value, defn *def, unsigned char arity+               ,FileOffset mostRecentHidden)+{+  unsigned char c;+  HIDE(fprintf(stderr+              ,"countCAF: caf=0x%x, value=0x%x, arity=0x%x, hidden=0x%x\n"+              ,caf,value,arity,mostRecentHidden);)+  if ((value<DoLambda) || (value==caf)) return;+  if (value==mostRecentHidden) return;+  freadAt(value,&c,sizeof(unsigned char),1,HatFileRandom);+  switch (lower5(c)) {  /* lower 5 bits identify the TraceType */+    case ExpApp:+        HIDE(fprintf(stderr,"countCAF: found ExpApp\n");)+        if (hasSrcPos(c)) { readFO(); }+        { unsigned char size;+          FileOffset result, fun;  defn *atom;  item *it;+          readFO();	/* parent */+          result = readFO();+          fun = readFO();+          fread(&size,sizeof(unsigned char),1,HatFileRandom);   /* arity */+          if (fun < caf) {      /* fun already seen in linear scan */+            atom = (defn*)FM_lookup(map2,(cast)fun);+            if (atom) {+              it = (item*)FM_lookup(map1,(cast)atom->atom);+              if (it) {+                defn *def2;+                def2 = (defn*)malloc(sizeof(defn));+                def->next = def2;+                def2->atom  = atom->atom;+                def2->arity = it->arity - (size+arity);+                def2->next  = (defn*)0;+              }+            }+          } else { /* fun not yet seen; linear scan has not reached it */+            countCAFResult(caf,fun,def,size+arity,mostRecentHidden);+          }+        }+        break;+    case ExpValueUse:+        HIDE(fprintf(stderr,"countCAF: found ExpValueUse\n");)+        if (hasSrcPos(c)) { readFO(); }+        { FileOffset var; item *it;+          readFO();             /* parent */+          var = readFO();       /* atom */+          if ((var==Lambda)||(var==DoLambda)) return;+          if (var < caf) {+            HIDE(fprintf(stderr,"countCAF: var=0x%x < caf=0x%x\n",var,caf);)+            it = (item*)FM_lookup(map1,(cast)var);+            HIDE(if (it) fprintf(stderr,"countCAF: var=%s\n",it->name);)+            if (it && (arity<it->arity)) {+              defn *def2;+              HIDE(fprintf(stderr,"countCAF: STORING caf=0x%x var=%s, size=%d\n",caf,it->name,arity);)+              def2 = (defn*)malloc(sizeof(defn));+              def->next = def2;+              def2->atom  = var;+              def2->arity = it->arity - arity;+              def2->next  = (defn*)0;+            }+          } else {+            HIDE(fprintf(stderr,"countCAF: var=0x%x > caf=0x%x\n",var,caf);)+            countCAFResult(caf,var,def,arity,mostRecentHidden);+          }+        }+        break;+    case ExpProjection:+        HIDE(fprintf(stderr,"countCAF: found ExpProjection\n");)+        if (hasSrcPos(c)) { readFO(); }+        { FileOffset result;+          readFO();     /* parent */+          result = readFO();+          countCAFResult(caf,result,def,arity,mostRecentHidden);+        }+        break;+    case ExpHidden:+        HIDE(fprintf(stderr,"countCAF: found ExpHidden\n");)+        { FileOffset result;+          readFO();     /* parent */+          result = readFO();+          countCAFResult(caf,result,def,arity,value);+        }+        break;+    case ExpForward:+        HIDE(fprintf(stderr,"countCAF: found ExpForward\n");)+        { FileOffset result;+          result = readFO();+          countCAFResult(caf,result,def,arity,mostRecentHidden);+        }+        break;+    case AtomVariable:+        readFO();	/* skip module pointer */+        { int x; fread(&x,sizeof(int),1,HatFileRandom);	} /* skip line/col */+        { int x; fread(&x,sizeof(int),1,HatFileRandom);	} /* skip line/col */+        { char x; fread(&x,sizeof(char),1,HatFileRandom); } /* skip fixity */+        { unsigned char size; char *id;+          fread(&size,sizeof(unsigned char),1,HatFileRandom);+          id = readString();+          HIDE(fprintf(stderr,"countCAF: found AtomVariable %s\n",id);)+          if (arity < size) {+            defn *def2;+            HIDE(fprintf(stderr,"countCAF: STORING caf=0x%x var=%s, size=%d\n",caf,id,arity);)+            map1_insert(value,id,TopId,size);+            def2 = (defn*)malloc(sizeof(defn));+            def->next   = def2;+            def2->atom  = value;+            def2->arity = size - arity;+            def2->next  = (defn*)0;+          }+        }+        break;+    default:+        HIDE(fprintf(stderr,"countCAF: found something else\n");)+        break;+  }+  return;+}+
+ tools/hat-names.h view
@@ -0,0 +1,68 @@+#ifndef _HAT_NAMES_H+#define _HAT_NAMES_H++#include <unistd.h>+#include <stdlib.h>+#include "art.h"++#define MAX_FILENAME 1024++/* We are interested in distinguishing three different kinds of identifier:+ *    variables defined at the top level+ *    variables defined in a local scope+ *    data constructors+ */+typedef enum {+    TopId, LocalId, Construct+} idkind;++/* These are the things we are interested in for each identifier:+ *   - its name, (+ info: defining module, srcloc, fixity, etc.)+ *   - its kind (local, global, constructor)+ *   - its arity+ *   - how many times it was applied at its full arity and gave a result+ *   - how many times it was applied at its full arity but did not give a result+ *   - how many times it was applied at its full arity but never demanded+ */+typedef struct {+    char* name;+    FileOffset thispos;+    idkind kind;+    unsigned char arity;+    int uses;		/* number of evaluated applications */+    int pending;	/* number of entered but unevaluated applications */+    int thunks;		/* number of applications never demanded */+} item;++struct _defn {+    FileOffset atom;+    unsigned char arity;+    struct _defn *next;+};+typedef struct _defn defn;++/* Return the data to Haskell-land */+FileOffset itemIdent   (item* i);+int        itemArity   (item* i);+int        itemUses    (item* i);+int        itemPending (item* i);+int        itemThunks  (item* i);+item*      getItemPtr  (item **arr, int n);+item**     getGlobals  (void);+item**     getLocals   (void);+item**     getConstrs  (void);+int        getGlobalsN (void);+int        getLocalsN  (void);+int        getConstrsN (void);+++/* do the work */+void	collateIdents	(void);+void	q_oneNode	(void);+void	countCAFResult	(FileOffset caf+			,FileOffset value+			,defn *def+			,unsigned char arity+			,FileOffset mostRecentHidden);++#endif
+ tools/list.h view
@@ -0,0 +1,35 @@+/*+ *  list.h+ *  + *+ *  Created by Thomas Davie on Fri Jan 22 2004.+ *+ */++#ifndef _LIST+#define _LIST++#ifndef false+#define false 0+#endif+#ifndef true+#define true !false+#endif++typedef struct list_s+{+    void *item;+    struct list_s *next;+} list;++list *list_newEmptyList(void);+void list_delete(list *theList);+void list_add(list *theList, void *newItem);+void list_remove(list **theList, void *theItem);+void list_remove_string(list **theList, char *theItem);+void list_push(list *theList, void *newItem);+void* list_pop(list *theList);+char list_contains(list *theList, void *searchItem);+char list_contains_string(list *theList, char *searchItem);++#endif
+ tools/nodehash.h view
@@ -0,0 +1,30 @@+/*+ *  hatNodeHash.h+ *  + *+ *  Created by Thomas Davie on Fri Nov 21 2003.+ *  Copyright (c) 2003 Thomas Davie. All rights reserved.+ *+ */++#include "animnode.h"+#include "nodelist.h"++#ifndef _NODE_HASH+#define _NODE_HASH++#define HASH_SIZE 100++typedef struct nodehash_s+{+    nodelist **hashLists;+    unsigned long filesize;+    FILE *hatFile;+} nodehash;++nodehash* nodehash_newByOpeningFile(const char *filename);+void nodehash_delete(nodehash *theHash);++node* nodehash_getNode(nodehash *theHash, unsigned long fileOffset);++#endif
+ tools/nodelist.h view
@@ -0,0 +1,35 @@+/*+ *  nodelist.h+ *  + *+ *  Created by Thomas Davie on Thu Dec 04 2003.+ *+ */++#include "animnode.h"++#ifndef _NODELIST+#define _NODELIST++#ifndef false+#define false 0+#endif+#ifndef true+#define true !false+#endif++typedef struct nodelist_s+{+    node *item;+    struct nodelist_s *next;+} nodelist;++nodelist *nodelist_newEmptyList(void);+void nodelist_delete(nodelist *list);+void nodelist_add(nodelist *list, node *newItem);+void nodelist_push(nodelist *list, node *newItem);+node* nodelist_pop(nodelist *list);+char nodelist_contains (nodelist *list, unsigned long nodeOffset);+node* nodelist_retrieve(nodelist *list, unsigned long nodeOffset);++#endif
+ tools/nontermutils.c view
@@ -0,0 +1,583 @@+#include <stdlib.h>+#include <stdio.h>+#include <string.h>+#include "nontermutils.h"++/* nodecount holds the number of node accesses in this run of the program */+long nodecount; ++/* This function searches for the root of the ART graph. The function+ * scans through the file linearly, looking for an ExpConstDef node+ * which points to an Atom called 'main'. This is (sort of) the root of+ * the graph. It's good enough, anyway+ */+FileOffset +getRootNode( void )+{+  FileOffset curr, root, atom;+  int err; char tag;+  Ident *atomvariable;++  q_position = 0x10;+  fseek(HatFileSeq,q_position,SEEK_SET);+  root = 0x00;+  while (root == 0x00) {+    nodecount++;+    curr = q_position;+    err = q_fread(&tag,sizeof(unsigned char),1,HatFileSeq);+    if (tag == ExpConstDef) {+      q_readFO(); // throw away the parent+      q_readFO(); // throw away the result+      atom = q_readFO();+      atomvariable = readAtomAt(atom); +      if ( strcmp( atomvariable->idname, "main") == 0 ) {+	root = curr;+      }+      free(atomvariable);+    }+    q_skipNode(tag);+  }+  return root;+}++/* take a FileOffset pointing to a node and get the node that+ * immediately follows it in the ART file. This uses q_skipNode, which+ * is a Hat function that skips a filenode, but which requires a tag+ * giving the node type. The nextFileNode function mainly just gets that+ * tag.+ */+FileOffset +nextFileNode( FileOffset fo )+{+  int err; char tag;++  if ( q_position != fo ) {+    q_position = fo; +    fseek(HatFileSeq,q_position,SEEK_SET);+  }++  err = q_fread(&tag,sizeof(unsigned char),1,HatFileSeq);+  q_skipNode(tag);++  if (q_position <= filesize ) {+    return q_position;+  } else {+    return 0; +  }+}++/* get the pointer to an Expression Application's function. This just+ * involves using readFO to pull out the correct pointer.+ */+FileOffset +getFuncPtr( FileOffset fo )+{+  char *id, c;+  FileOffset ptr = 0;+  freadAt(fo,&c,sizeof(char),1,HatFileRandom);+  //fprintf(stderr, "considering 1st expression at %x\n", fo);+  switch (lower5(c)) {+    case ExpApp:+	if (hasSrcPos(c)) { readFO(); }+	readFO();				/* skip parent */+        readFO();				/* skip result */+        fo = readFO();				/* value app */+	freadAt(fo,&c,sizeof(char),1,HatFileRandom);+        //fprintf(stderr, "considering 2nd expression at %x\n", fo);+	readFO();                             	/* skip srcref */+	readFO();                         	/* skip parent */+        ptr = readFO();			  	/* function ptr */+	break;+    default: +        fprintf(stderr, "%s: expected Expression Application at 0x%x\n",+		progname,fo);+        exit(1);+  }+  //fprintf(stderr, "pointer: %x\n", ptr);+  return ptr;+}++/* take a FileOffset pointing to a function atom and get its name */+char *+getFuncNm( FileOffset fo )+{+  char *name;+  Ident *func;+  func = readAtomAt(fo);+  name = func->idname;+  free(func);+  return(name);+}++/* take a FileOffset pointing to a function atom and get the module name */+char *+getFuncMod(FileOffset fo)+{+  char *mod;+  Ident *func;+  func = readAtomAt(fo);+  mod = func->modname;+  free(func);+  return(mod);+}++++/* initialise the counter variable for the number of accesses to the ART+ * nodes+ */+void initialiseCount(void)+{+  nodecount = 0;+}++/* increment the node-access count by the value of the argument */+void incCount(long x)+{+  nodecount = nodecount + x;+}++/* get the node-access count */+long getCount(void)+{+  return nodecount;+}++/* This is a modified version of the Hat function getExpArg. The+ * original function takes a filenode, and gets the value of a+ * particular agument. However, it also followed some of the argument+ * pointers, specifically the pointers for Expression Applications. This+ * had some odd results for black-hat, so I've stopped it following most+ * pointers. The getResultRestricted function takes the place of+ * getResult, and only follows a small number of pointer-types.+ */+FileOffset+getImmediateExpArg (FileOffset fo, int n)+{+  char c;+  int i=0;+  FileOffset ptr;++  nodecount++;++  //fprintf(stderr,"getExpArg 0x%x\n",fo);+  freadAt(fo,&c,sizeof(char),1,HatFileRandom);+  switch (lower5(c)) {+    case ExpApp:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        readFO();				/* skip result */+        ptr = readFO();				/* fun/constructor */+        if (n==0) return getResultRestricted(ptr);+        fread(&c,sizeof(char),1,HatFileRandom);	/* get arity */+        if (n<=c) {+          for (i=1; i<n; i++) readFO();		/* skip other args */+          ptr = readFO();			/* get n'th arg */+          return getResultRestricted(ptr);+        } else+          return fo;+        break;+    case ExpValueApp:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        ptr = readFO();				/* fun/constructor */+        if (n==0) return ptr;	/* no result-chain - fun is already an atom */+        fread(&c,sizeof(char),1,HatFileRandom);	/* get arity */+        if (n<=c) {+          for (i=1; i<n; i++) readFO();		/* skip other args */+          ptr = readFO();			/* get n'th arg */+          return getResultRestricted(ptr);+        } else+          return fo;+        break;+    case ExpValueUse:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        ptr = readFO();				/* CAF */+        return ptr;	/* no result-chain - fun is already an atom */+        break;+    case ExpConstDef:+    case ExpConstUse:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        ptr = readFO();				/* CAF */+        return getResultRestricted(ptr);+        break;+    case ExpGuard:+    case ExpCase:+    case ExpIf:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        readFO();				/* skip result */+        ptr = readFO();				/* get condition */+        return getResult(ptr,True);+        break;+    case ExpFieldUpdate:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        readFO();				/* skip result */+        ptr = readFO();				/* exp/constructor */+        if (n==0) return getResult(ptr,True);+        fread(&c,sizeof(char),1,HatFileRandom);	/* get arity */+        if (n<=c) {+          for (i=0; i<c; i++) readFO();		/* skip binder labels */+          for (i=1; i<n; i++) readFO();		/* skip other bindees */+          ptr = readFO();			/* get n'th bindee */+          return getResultRestricted(ptr);+        } else+          return fo;+        break;+    case ExpProjection:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        ptr = readFO();				/* get expr */+        return ptr;+        break;+    case ExpForward:+        ptr = readFO();				/* get expr */+        return ptr;+        break;+    case ExpChar:+    case ExpInt:+    case ExpInteger:+    case ExpRat:+    case ExpRational:+    case ExpFloat:+    case ExpDouble:+    case ExpHidden:+    case ExpDoStmt:+    case Module:+    case SrcPos:+    case AtomVariable:+    case AtomConstructor:+    case AtomAbstract:+    default:+        return fo;+        break;+  }+}++/* This function is used by getImmediateExpArg, to follow argument+ * pointers. It follows ExpConstUse pointers, but nothing else.+ * Otherwise, it simply returns the pointer value.+ * I could probably fold this into the getImmediateExpArg function body.+ */+getResultRestricted(FileOffset fo)+{+  char c;+  FileOffset ptr;+  if (fo<=DoLambda) return fixInterrupt(fo);+  freadAt(fo,&c,sizeof(char),1,HatFileRandom);+  switch (lower5(c)) {+    case ExpConstUse:+        if (hasSrcPos(c)) { readFO(); }		/* skip usage position */+        readFO();				/* skip parent */+        ptr = readFO();				/* CAF */+	return getResultRestricted(ptr);+        break;+    default:+	return fo;+	break;+  }+}+  +/* peekResultMod is a modified version of peekResult from Hat, which takes a+ * single step down the result chain. It has been rewritten, to avoid+ * some expressions appearing twice in the search path+ *+ */++FileOffset+peekResultMod (FileOffset fo)+{+  char c;+  FileOffset result;+  +  nodecount++;++  //HIDE(fprintf(stderr,"peekResult 0x%x\n",fo);)+  if (fo<=DoLambda) return fixInterrupt(fo);      /* trace is Unevaluated etc */+  freadAt(fo,&c,sizeof(char),1,HatFileRandom);+  switch (lower5(c)) {+    case ExpApp:+    case ExpGuard:+    case ExpCase:+    case ExpIf:+    case ExpFieldUpdate:+        if (hasSrcPos(c)) { readFO(); }		/* skip use position */+        readFO();				/* skip parent */+        result = readFO();			/* get result */+        break;+    case ExpConstUse:+    case ExpProjection:+        if (hasSrcPos(c)) { readFO(); }		/* skip use position */+        readFO();				/* skip parent */+        result = readFO();			/* get result */+        break;+    case ExpConstDef:+        readFO();				/* skip parent */+        result = readFO();			/* get result */+        break;+    case ExpForward:+    case ExpDoStmt:+        result = readFO();			/* get result */+        break;+    case ExpValueApp:+    case ExpValueUse:+    case ExpChar:+    case ExpInt:+    case ExpInteger:+    case ExpRat:+    case ExpRational:+    case ExpFloat:+    case ExpDouble:+        //HIDE(fprintf(stderr,"getResult: result is itself\n");)+        result = fo;+        break;+    case ExpHidden:+        readFO();				/* skip parent */+        result = readFO();			/* get result */+        break;+    case AtomVariable:+    case AtomConstructor:+    case AtomAbstract:+    default:+        return 0;+        break;+  }++  if (result<=DoLambda) return fixInterrupt(result); +  freadAt(result,&c,sizeof(char),1,HatFileRandom);+  switch (lower5(c)) {+    case ExpConstDef:+	return peekResultMod(result);+        break;+    case ExpProjection:+        return peekResultMod(result);+	break;+    default:+	return fixInterrupt(result); +	break;+  }+}+++/* The getResultHT function is a modified version of getResult that+ * uses a hashtable to reduce the stupid amount of time it takes if you try+ * and get the result of a function in a non-terminating file.  + */+FOHashTable *hashTable, *hashTableNew = NULL;++static FileOffset mostRecentHidden=0;++/* getResultHt starts to get a result value for a function. Basically+ * all it does is initialise the mostRecentHidden variable for catching+ * rogue Hidden loops+ */+FileOffset+getResultHT (FileOffset fo, Bool stopAtHidden)+{+  FileOffset result;+  //fprintf(stderr, "starting on 0x%x\n", fo);+  if (fo==mostRecentHidden) return fo;+  mostRecentHidden=0;+  result = getResultNoCycleHT(fo,stopAtHidden);+  //fprintf(stderr, "result: %x\n", result);+  return result;+}++/* getResultNoCycleHT actually does the leg-work of getting the function+ * results. The old getResult used lots of calls like this to express+ * recursion:+ *    return getResult(foo, bar);+ * In order that the results are actually entered into the hash table,+ * these have been replaced with:+ *    returnval = getResult(foo, bar);+ * the value is then entered into the hash table once it has been+ * aquired. The only problem is that, while the original version was+ * probably compiled into constant-space iteration, this version can't be. So,+ * with very large ART files, you will eventually end up with a huge number+ * of calls to getResultNoCycleHT piling up on the stack, which may + * break black-hat / hat-nonterm in some horrible non-reproducible manner. + * However, this hasn't happened to me, yet.+ */+FileOffset+getResultNoCycleHT(FileOffset fo, Bool stopAtHidden)+{+  char c;+  FileOffset result, returnval;++  nodecount++;+   +  if (hashTable == NULL) hashTable = foInitTable(10000);+  if ((returnval = foHashRetrieve(hashTable, fo)) != 0) return returnval;+  +  if (fo<=DoLambda) return fixInterrupt(fo);      /* trace is Unevaluated etc */+  freadAt(fo,&c,sizeof(char),1,HatFileRandom);+  switch (lower5(c)) {+    case ExpApp:+    case ExpGuard:+    case ExpCase:+    case ExpIf:+    case ExpFieldUpdate:+        if (hasSrcPos(c)) { readFO(); }		/* skip use position */+        readFO();				/* skip parent */+        result = readFO();			/* get result */+        if (result==fo) return fo;+        else if (result<=DoLambda) return fixInterrupt(fo);+        else returnval = getResultNoCycleHT(result,False);+        break;+//  case ExpValueApp:+//  case ExpValueUse:+//      if (hasSrcPos(c)) { readFO(); }		/* skip use position */+//      readFO();				/* skip parent */+//      return readFO();			/* return Atom pointer */+//      break;+    case ExpConstUse:+        if (hasSrcPos(c)) { readFO(); }		/* skip use position */+        readFO();				/* skip parent */+        result = readFO();			/* get result */+        if (result<=DoLambda) return fixInterrupt(fo);+        else returnval = getResultNoCycleHT(result,False);+						/* follow ExpConstDef pointer */+        break;+    case ExpConstDef:+        readFO();				/* skip parent */+        result = readFO();			/* get result */+        if (result<=DoLambda) return fixInterrupt(fo);+        returnval = getResultNoCycleHT(result,False);+        break;+    case ExpForward:+        returnval = getResultNoCycleHT(readFO(),stopAtHidden);+        break;					/* continue to detect Hidden */+    case ExpDoStmt:+        returnval = getResultNoCycleHT(readFO(),False);	/* get result */+        break;+    case ExpProjection:+        return fo;+    case ExpValueApp:+    case ExpValueUse:+    case ExpChar:+    case ExpInt:+    case ExpInteger:+    case ExpRat:+    case ExpRational:+    case ExpFloat:+    case ExpDouble:+//  case AtomVariable:+//  case AtomConstructor:+//  case AtomAbstract:+        return fo;+        break;+    case ExpHidden:+        if (stopAtHidden) return fo;+	// instead of returning the file offset of the hidden in the +	// case of a loop, return the Entered filePointer+        else if (fo==mostRecentHidden) return Entered; +        else {+          mostRecentHidden = fo;		/* keep, to detect a loop */+          readFO();				/* skip parent */+          result = readFO();			/* get result */+          if (result==fo) return fo;+          else if (result<=DoLambda) return fixInterrupt(fo);+          else returnval = getResultNoCycleHT(result,False);+        }+        break;+    case AtomVariable:+    case AtomConstructor:+    case AtomAbstract:+    default:+        returnval = 0;+        break;+  }++  foHashInsert(hashTable, fo, returnval);+  return returnval;+}+++/* Functions for manipulating a hash table + *+ * The hash table is a simple bucket-table, with each table item+ * corresponding to a linked-list of entries. + *+ * The hash-table datatype is in the header file, nontermutils.h+ */++/* Initialise the hash table */+FOHashTable *+foInitTable ( unsigned long size ) +{+  unsigned long i;+  FOHashTable *table;+  table = (FOHashTable*)malloc(sizeof(FOHashTable));+  table->size = size;+  table->ht = (FOHashItem**)malloc( sizeof(FOHashItem *) * table->size);+  for (i=0; i < table->size; i++) table->ht[i] = NULL;+  return(table);+}++/* Deallocate the hash table */+void+foDestroyTable (FOHashTable *table)+{+  FOHashItem *item;+  unsigned long i;+  for (i=0; i < table->size; i++) {+    item = table->ht[i];+    while (item != NULL) {+      free(item);+      item = item->next;+    }+  }+  free(table);+}++/* insert an item into the hash table */+void+foHashInsert ( FOHashTable *table, FileOffset key, FileOffset entry )+{+  FOHashItem *item;+  unsigned long offset;+  offset = foHashFunc(table, key);++  if (table->ht[offset] == NULL) {+    item = (FOHashItem*)malloc(sizeof(FOHashItem));+    table->ht[offset] = item;+  } else {+    item = table->ht[offset];+    while (item->next != NULL) {+      item = item->next;+    }+    item->next = (FOHashItem*)malloc(sizeof(FOHashItem));+    item = item->next;+  }++  item->key = key;+  item->entry = entry;+  item->next = NULL;+}+  +/* make a hash-table key */+unsigned long+foHashFunc ( FOHashTable *table, FileOffset key )+{+  return( key % table->size );+}++/* retrieve an item from the hash table, or fail and return 0 */+FileOffset+foHashRetrieve (FOHashTable *table, FileOffset key)+{+  unsigned long offset;+  FOHashItem *item;+  FileOffset result;+  offset = foHashFunc( table, key );+  item = table->ht[offset];+  while (item != NULL) {+    if (item->key == key) return(item->entry);+    item = item->next;+  }+  return(0);+}+
+ tools/nontermutils.h view
@@ -0,0 +1,49 @@+#ifndef __NONTERMUTILS_H+#define __NONTERMUTILS_H+#include "art.h"+#include "artutils.h"+++// filenode manipulators+FileOffset getRootNode( void );+FileOffset nextFileNode( FileOffset fo );++// function node manipulators+FileOffset getFuncPtr( FileOffset fo );+char * getFuncNm( FileOffset fo );+char * getFuncMod(FileOffset fo);++// visited-node count manipulators+void initialiseCount(void);+void incCount(long x);+long getCount(void);++// modifications of Hat functions +#define fixInterrupt(fo)	(interrupt && fo==Entered ? Interrupted : fo)+FileOffset getImmediateExpArg (FileOffset fo, int n);+FileOffset peekResultMod (FileOffset fo);+FileOffset getResultHT (FileOffset fo, Bool stopAtHidden);+FileOffset getResultNoCycleHT(FileOffset fo, Bool stopAtHidden);++// Hash table implementation+typedef struct FOHashItem FOHashItem;++struct FOHashItem {+  FileOffset key, entry;+  FOHashItem *next;+};++typedef struct FOHashTable {+  unsigned long size;+  FOHashItem **ht;+} FOHashTable;++FOHashTable *foInitTable ( unsigned long size );+void foDestroyTable (FOHashTable *table);+void foHashInsert ( FOHashTable *table, FileOffset key, FileOffset entry );+unsigned long foHashFunc ( FOHashTable *table, FileOffset key );+FileOffset foHashRetrieve (FOHashTable *table, FileOffset key);++extern Bool interrupt;++#endif
+ tools/observeutils.c view
@@ -0,0 +1,568 @@+/*+ * Utility functions for hat-observe.+ * ----------------------------------+ */+#include <stdlib.h>+#include <stdio.h>+#include <string.h>+#include <signal.h>+#include "finitemap.h"+#include "art.h"+#include "artutils.h"+#include "observeutils.h"+#include "ntohl.h"++#define DEBUG 0++#if DEBUG+#define HIDE(x) x+#else+#define HIDE(x)+#endif++/* Some finite maps (i.e. lookup tables):+ * mapAtom2Info    :: FileNode -> Info+ * mapExp2Atom     :: FileNode -> Atom+ * mapContext2Atom :: FileNode -> Atom+ */+FiniteMap mapAtom2Info, mapExp2Atom, mapContext2Atom;++/* Insert into mapAtom2Info */+void+insert_mapAtom2Info (FileOffset atom, char* var, unsigned char arity)+{+  Info *info;+  info = (Info*)malloc(sizeof(Info));+  info->node  = atom;+  info->var   = var;+  info->arity = arity;+  FM_insert(mapAtom2Info,(cast)atom,(cast)info);+}+/* Insert into either mapExp2Atom or mapContext2Atom */+void+insert_map2 (FiniteMap map2, FileOffset exp, FileOffset atom+            ,unsigned char arity)+{+  Info *info = (Info*)0;+  info = FM_lookup(mapAtom2Info,(cast)atom);+  if (info) {+    Atom *fun;+    fun = (Atom*)malloc(sizeof(Atom));+    fun->atom  = atom;+    fun->arity = info->arity - arity;+    FM_insert(map2,(cast)exp,(cast)fun);+  }+}+/* free memory when no longer needed */+void+cleanup_info (FileOffset fo, Info* info) { free(info); }+void+cleanup_atom (FileOffset fo, Atom* atom) { free(atom); }+++/* Some global values for an observation search.  Only one search can+ * be active at once.+ */+Bool	o_srcpos, o_context, o_recursive;+char	*o_caller, *o_callee;+char	*o_module;+unsigned	o_linecol;+FileOffset	o_src_fo, o_module_fo;+unsigned char	o_arity=0;	/* oversaturate/override arity */+++/* Initialise the global state ready for a new observation to start. */+void+setObserveContext (Bool hascontext, Bool rec, int arity, char* caller)+{+/*struct sigaction sig;*/+  o_srcpos    = False;+  o_context   = hascontext;+  o_recursive = rec;+  o_caller    = strdup(caller);+  o_arity     = (unsigned char)arity;+  q_position  = 0x10;+  fseek(HatFileSeq,q_position,SEEK_SET);+  hat_interrupted = False;+/*sig.sa_handler = ctrlC; sigemptyset(&sig.sa_mask); sig.sa_flags=0; */+/*sigaction(SIGINT,&sig,(void*)0); */+  signal(SIGINT,ctrlC);+  /* Reset the maps here, freeing the tree contents also. */+  if (mapAtom2Info)    FM_destroy(mapAtom2Info);+  if (mapExp2Atom)     FM_destroy(mapExp2Atom);+  if (mapContext2Atom) FM_destroy(mapContext2Atom);+  mapAtom2Info    = FM_new((FMComparison)fileoffset_compare+                          ,(FMFreeItem)cleanup_info);+  mapExp2Atom     = FM_new((FMComparison)fileoffset_compare+                          ,(FMFreeItem)cleanup_atom);+  mapContext2Atom = FM_new((FMComparison)fileoffset_compare+                          ,(FMFreeItem)cleanup_atom);+  HIDE(fprintf(stderr,"setObserveContext: filepos=0x%x\n",ftell(HatFileSeq));)+}++/* Some more initialisation of the global state for a new observation,+ * together with the first search for a matching node.+ */+FileOffset+lookForFirstApp (char* callee)+{+  o_callee = strdup(callee);+  HIDE(fprintf(stderr,"lookForFirstApp: %s\n",o_callee);)+  return nextObservation(0);+}++FileOffset+lookForFirstSrc (int line, int col, char* module)+{+  o_srcpos  = True;+  o_module  = strdup(module);+  o_linecol = htonl((unsigned)(line*10000) + (unsigned)col);+  o_module_fo = o_src_fo = 0;+  HIDE(fprintf(stderr,"lookForFirstSrc: %s %d\n",o_module,o_linecol);)+  return nextObservation(0);+}++/* Search sequentially from the current position for the next matching+ * application.  The argument is not used - it is only there to+ * ensure that the Haskell IO action is executed.+ */+FileOffset+nextObservation (FileOffset seen)+{+  FileOffset node=0;+  if (o_srcpos) {+    do { node = srcSearch(); } while (!node);+  } else {+    do { node = varSearch(); } while (!node);+  }+  HIDE(fprintf(stderr,"nextObservation: 0x%x\n",node);)+  return node;+}++/* varSearch() moves the sequential file pointer past a single node in+ * the file, looking for a particular variable or constructor application.+ *  *  If the node is an AtomVariable matching the var we are+ *     searching for, we record it in the Atom2Info map.+ *  *  If it is an ExpValueUse whose atom value is already in the+ *     Atom2Info map, then we record it in the Exp2Atom map.+ *  *  If the node is an application whose function position+ *     matches the var we are looking for (i.e. it can be found in+ *     the Exp2Atom map), and the arity is correct, we return the+ *     node address.+ *  *  If the application is undersaturated, we simply record the+ *     address in the Exp2Atom map, as for an ExpValueUse.+ *  *  CAFS: If the node is a CAF definition whose Atom matches the var,+ *     we record its address in the Exp2Atom map.  If it is a CAF use+ *     whose definition can be found in the Exp2Atom map, we return the+ *     node address.+ *  *  Constructors are just like vars, except for zero-arity constrs,+ *     which are recorded in as ExpValueUse rather than ExpConstUse.+ *+ * If we were asked to exclude recursive calls, then we additionally keep+ * a record of all calls to this var in the Context2Atom map, and check+ * the parent to decide whether we have found a suitable matching application.+ *+ * Similarly, if the query included a context, then we keep a note of all+ * applications of that context var, and again check the parent to decide+ * whether we have found a match.+ */+FileOffset+varSearch (void)+{+  unsigned char c; int err;+  FileOffset node = q_position;+  HIDE(fprintf(stderr,"\n0x%x: ",q_position);)+  if (hat_interrupted) return 3;+  err = q_fread(&c,sizeof(unsigned char),1,HatFileSeq);+  if (err!=1) return 1;	/* Assume EOF */+  switch (lower5(c)) {  /* lower 5 bits identify the TraceType */+    case ExpApp:+        if (hasSrcPos(c)) { q_readFO(); }+        { unsigned char size, next, i;+          FileOffset parent, result, fun; Atom *atom; Info *it;+          parent = q_readFO();+          result = q_readFO();+          fun = q_readFO();+          q_fread(&size,sizeof(unsigned char),1,HatFileSeq);  /* get arity */+          for (i=0; i<size; i++) q_readFO();    /* skip args */+          /* First check if this is a possible caller context */+          if (o_context) {+            atom = (Atom*)FM_lookup(mapContext2Atom,(cast)fun);+            if (atom) {+              it = (Info*)FM_lookup(mapAtom2Info,(cast)atom->atom);+              if (it && !strcmp(it->var,o_caller)) {+                insert_map2(mapContext2Atom,node,atom->atom,size);+                HIDE(fprintf(stderr,"App of %s (context) ",it->var);)+              }+            }+          }+          /* Then check if we have found the right callee */+          atom = (Atom*)FM_lookup(mapExp2Atom,(cast)fun);+          if (atom) {+            it = (Info*)FM_lookup(mapAtom2Info,(cast)atom->atom);+            if (it && !strcmp(it->var,o_callee)) {+              HIDE(fprintf(stderr,"App of %s (callee)",it->var);)+              if (size >= atom->arity) {  /* is not undersaturated */+                if (!o_recursive) {  /* if excluding recursive calls */+                  insert_map2(mapContext2Atom,node,atom->atom,size);+                  atom = (Atom*)FM_lookup(mapContext2Atom,(cast)parent);+                  if (atom) {+                    it =(Info*)FM_lookup(mapAtom2Info,(cast)atom->atom);+                    if (it && !strcmp(it->var,o_callee)) return 0;+                    else return node;+                  } else return node;+                } else if (o_context) {	 /* if context matters */+                  atom = (Atom*)FM_lookup(mapContext2Atom,(cast)parent);+                  if (atom) {+                    it =(Info*)FM_lookup(mapAtom2Info,(cast)atom->atom);+                    HIDE(fprintf(stderr,"(context is %s)",it->var);)+                    if (it && !strcmp(it->var,o_caller)) return node;+                  }+                } else return node;  /* no context, no recursive exclusion */+              } else insert_map2(mapExp2Atom,node,atom->atom,size);+            }+          }+        } break;+    case ExpValueApp:+        if (hasSrcPos(c)) { q_readFO(); }+        { unsigned char size, next, i;+          FileOffset parent, fun; Atom *atom; Info *it;+          parent = q_readFO();  /* skip parent */+          fun = q_readFO();     /* fun ptr is an Atom ref */+          q_fread(&size,sizeof(unsigned char),1,HatFileSeq);    /* get arity */+          for (i=0; i<size; i++) q_readFO();    /* skip args */+          it = (Info*)FM_lookup(mapAtom2Info,(cast)fun);+          if (it && !strcmp(it->var,o_callee)) {+            if (size >= it->arity) {+              if (o_context) {	/* if context matters */+                atom = (Atom*)FM_lookup(mapContext2Atom,(cast)parent);+                if (atom) {+                  it =(Info*)FM_lookup(mapAtom2Info,(cast)atom->atom);+                  HIDE(fprintf(stderr,"(context is %s)",it->var);)+                  if (it && !strcmp(it->var,o_caller)) return node;+                }+              } else return node;+            } else insert_map2(mapExp2Atom,node,fun,size);+          }+        } break;+    case AtomConstructor:+    case AtomVariable:+        q_readFO();             /* skip module pointer */+        { int x; q_fread(&x,sizeof(int),1,HatFileSeq); }   /* skip line/col */+        { int x; q_fread(&x,sizeof(int),1,HatFileSeq); }   /* skip line/col */+        { char x; q_fread(&x,sizeof(char),1,HatFileSeq); } /* skip fixity */+        { unsigned char arity, tmp;+          char *id;+          q_fread(&arity,sizeof(unsigned char),1,HatFileSeq);+          id = q_readString();+          if (lower5(c)==AtomConstructor && hasFields(c))+            for (tmp=arity;tmp-->0;) q_readFO();+          HIDE(fprintf(stderr,"%s %s ",(lower5(c)==AtomVariable?"Var":"Con"),id);)+          if (!strcmp(id,o_callee) || !strcmp(id,o_caller)) {+            insert_mapAtom2Info(node,id,((o_arity>arity) ? o_arity : arity));+            HIDE(fprintf(stderr,"(recorded at 0x%x, arity=%d)",node,arity);)+            HIDE(fprintf(stderr,"(o_arity=%d)",node,o_arity);)+          }+        } break;+    case ExpValueUse:+        if (hasSrcPos(c)) { q_readFO(); }+        { FileOffset parent, atom; Info *it;+          parent = q_readFO();	/* get parent */+          atom = q_readFO();	/* get atom */+          if ((atom==Lambda)||(atom==DoLambda)) {+            if (o_context || !o_recursive) {+              Atom *atom;	/* shadows outer scope */+              atom = (Atom*)FM_lookup(mapContext2Atom,(cast)parent);+              if (atom) {+                it = (Info*)FM_lookup(mapAtom2Info,(cast)atom->atom);+                if (it) {+                  if ( (!o_recursive && !strcmp(it->var,o_callee))+                     || (o_context && !strcmp(it->var,o_caller)) ) {+                    insert_map2(mapContext2Atom,node,atom->atom,0);+                  }+                }+              }+            }+          } else {+            it = (Info*)FM_lookup(mapAtom2Info,(cast)atom);+            if (it) {+              if (!strcmp(it->var,o_callee)) {+                insert_map2(mapExp2Atom,node,atom,0);+                if (!o_recursive) insert_map2(mapContext2Atom,node,atom,0);+              }+              if (!strcmp(it->var,o_caller)) {+                insert_map2(mapContext2Atom,node,atom,0);+              }+              HIDE(fprintf(stderr,"ValueUse %s",it->var);)+              if (it->arity==0 && !strcmp(it->var,o_callee)) return node;+            }+          }+        } break;+    case ExpConstDef:+        { FileOffset atom, result; Info *it;+          q_readFO();		/* skip parent */+          result = q_readFO();	/* result might contain desired function */+          atom = q_readFO();	/* get atom */+          it = (Info*)FM_lookup(mapAtom2Info,(cast)atom);+          if (it) {+            HIDE(fprintf(stderr,"ConstDef %s",it->var);)+            if (!strcmp(it->var,o_callee))+              insert_map2(mapExp2Atom,node,atom,0);+            else if (o_context && !strcmp(it->var,o_caller))+              insert_map2(mapContext2Atom,node,atom,0);+          //if (!strcmp(it->var,o_callee)) return node;+          } else {+            HIDE(fprintf(stderr,"ConstDef (searchCAF)");)+            searchCAFResult(node,result,0,0);+          }+        } break;+    case ExpConstUse:+        HIDE(fprintf(stderr,"ConstUse ");)+        if (hasSrcPos(c)) { q_readFO(); }+        { FileOffset exp; Atom *def; Info *it;+          q_readFO();		/* skip parent */+          exp = q_readFO();	/* get ExpConstDef location */+          def = (Atom*)FM_lookup(mapExp2Atom,(cast)exp);+          if (def) {+            insert_map2(mapExp2Atom,node,def->atom,def->arity);	// allows oversat apps+            it = FM_lookup(mapAtom2Info,(cast)def->atom);+            HIDE(if (it) fprintf(stderr,"%s",it->var);)+            if (it && !strcmp(it->var,o_callee)) return node;+          } else {+            def = (Atom*)FM_lookup(mapContext2Atom,(cast)exp);+            if (def) {+              it = FM_lookup(mapAtom2Info,(cast)def->atom);+              if (it && !strcmp(it->var,o_caller))+                insert_map2(mapContext2Atom,node,def->atom,def->arity);+            }+          }+        } break;+    case ExpGuard:+    case ExpCase:+    case ExpIf:+        if (o_context || !o_recursive) {+          if (hasSrcPos(c)) { q_readFO(); }+          { FileOffset parent; Atom *atom; Info *it;+            parent = q_readFO();+            q_readFO();	/* skip result */+            q_readFO();	/* skip condition */+            atom = (Atom*)FM_lookup(mapContext2Atom,(cast)parent);+            if (atom) {+              it = (Info*)FM_lookup(mapAtom2Info,(cast)atom->atom);+              if (it) {+                if ( (!o_recursive && !strcmp(it->var,o_callee))+                   || (o_context && !strcmp(it->var,o_caller)) ) {+                  insert_map2(mapContext2Atom,node,atom->atom,0);+                }+              }+            }+          }+        } else q_skipNode(c);+        break;+    default:+        q_skipNode(c);+        break;+  }+  return 0;	/* if we didn't find an application */+}++/* srcSearch() moves the sequential file pointer past a single node in+ * the file, looking for a particular usage position.  Having found the+ * usage position, we then look for any application or value used at that+ * position.+ */+FileOffset+srcSearch (void)+{+  unsigned char c; int err;+  FileOffset node = q_position;+  HIDE(fprintf(stderr,"\n0x%x: ",q_position);)+  if (hat_interrupted) return 3;+  err = q_fread(&c,sizeof(unsigned char),1,HatFileSeq);+  if (err!=1) return 1;	/* Assume EOF */+  if (!o_src_fo) {+    switch (lower5(c)) {  /* lower 5 bits identify the TraceType */+      case Module:+          HIDE(fprintf(stderr,"Module ");)+          if (o_module_fo) q_skipNode(c);+          else {+            char *file;+            q_readString();	/* skip module name */+            file = q_readString();+            HIDE(fprintf(stderr,"File %s ",file);)+            if (!strcmp(file,o_module)) {+              HIDE(fprintf(stderr,"(Got it!)");)+              o_module_fo = node;+            }+          } break;+      case SrcPos:+          HIDE(fprintf(stderr,"SrcPos ");)+          if (!o_module_fo) q_skipNode(c);+          else {+            FileOffset mod; unsigned linecol;+            mod = q_readFO();+            q_fread(&linecol,sizeof(unsigned),1,HatFileSeq);+            { int x; q_fread(&x,sizeof(int),1,HatFileSeq); }/* skip line/col */+            HIDE(fprintf(stderr,"Line/Col %d ",linecol);)+            if (mod==o_module_fo && linecol==o_linecol) {+              HIDE(fprintf(stderr,"(Got it!)");)+              o_src_fo = node;+            }+          } break;+      default:+          q_skipNode(c);+          break;+    }+  } else {+    switch (lower5(c)) {  /* lower 5 bits identify the TraceType */+      case ExpApp:+          HIDE(fprintf(stderr,"ExpApp ");)+          if (hasSrcPos(c)) {+            unsigned char size, i; FileOffset fo;+            fo = q_readFO();+            HIDE(fprintf(stderr,"SrcPos=0x%x ",fo);)+            q_readFO(); q_readFO(); q_readFO();+            q_fread(&size,sizeof(unsigned char),1,HatFileSeq);	/* get arity */+            for (i=0; i<size; i++) q_readFO();	/* skip args */+            if (fo==o_src_fo) {+              HIDE(fprintf(stderr,"(Got it!)");)+              return node;+            }+          } else q_skipNode(c);+          break;+      default:+          q_skipNode(c);+          break;+    }+  }+  return 0;	/* if we didn't find an application at the src location */+}+++/* searchCAFResult() takes the result pointer of a CAF and searches the+ * result chain to discover whether the CAF ever reduced to a (partial)+ * application of the function we want to observe.  If so, then the+ * original CAF node should be memoised as if it were the function we+ * want.  The arity to memoise however, is the extent of undersaturatedness+ * of the partial application.+ */+void+searchCAFResult (FileOffset caf, FileOffset value, unsigned char arity+                ,FileOffset mostRecentHidden)+{+  unsigned char c;+  HIDE(fprintf(stderr+              ,"searchCAF: caf=0x%x, value=0x%x, arity=0x%x, hidden=0x%x\n"+              ,caf,value,arity,mostRecentHidden);)+  if ((value<DoLambda) || (value==caf)) return;+  if (value==mostRecentHidden) return;+  freadAt(value,&c,sizeof(unsigned char),1,HatFileRandom);+  switch (lower5(c)) {  /* lower 5 bits identify the TraceType */+    case ExpApp:+        HIDE(fprintf(stderr,"searchCAF: found ExpApp\n");)+        if (hasSrcPos(c)) { readFO(); }+        { unsigned char size;+          FileOffset result, fun;  Atom *atom;  Info *it;+          readFO();+          result = readFO();+          fun = readFO();+          fread(&size,sizeof(unsigned char),1,HatFileRandom);	/* arity */+          if (fun < caf) {	/* fun already seen in linear scan */+            if (o_context) {+              atom = (Atom*)FM_lookup(mapContext2Atom,(cast)fun);+              if (atom) {+                it = (Info*)FM_lookup(mapAtom2Info,(cast)atom->atom);+                if (it && !strcmp(it->var,o_caller)) {+                  insert_map2(mapContext2Atom,caf,atom->atom,size);+                }+              }+            }+            atom = (Atom*)FM_lookup(mapExp2Atom,(cast)fun);+            if (atom) {+              it = (Info*)FM_lookup(mapAtom2Info,(cast)atom->atom);+              if (it && !strcmp(it->var,o_callee)+                     && ((size+arity)<atom->arity)) {+                HIDE(fprintf(stderr,"searchCAF: STORING caf=0x%x var=%s, size=%d\n",caf,it->var,size);)+                insert_map2(mapExp2Atom,caf,atom->atom,size);+              }+            }+          } else { /* fun not yet seen; linear scan has not reached it */+            searchCAFResult(caf,fun,size+arity,mostRecentHidden);+          }+       // if (result!=caf) searchCAFResult(caf,result,arity,mostRecentHidden);+        }+        break;+    case ExpValueUse:+        HIDE(fprintf(stderr,"searchCAF: found ExpValueUse\n");)+        if (hasSrcPos(c)) { readFO(); }+        { FileOffset var; Info *it;+          readFO();		/* parent */+          var = readFO();	/* atom */+          if (var==Lambda) return;+          if (var==DoLambda) return;+          if (var < caf) {+            HIDE(fprintf(stderr,"searchCAF: var=0x%x < caf=0x%x\n",var,caf);)+            it = (Info*)FM_lookup(mapAtom2Info,(cast)var);+            HIDE(if (it) fprintf(stderr,"searchCAF: var=%s\n",it->var);)+            if (it && !strcmp(it->var,o_callee) && (arity<it->arity)) {+              HIDE(fprintf(stderr,"searchCAF: STORING caf=0x%x var=%s, size=%d\n",caf,it->var,arity);)+              insert_map2(mapExp2Atom,caf,var,arity);+            }+          } else {+            HIDE(fprintf(stderr,"searchCAF: var=0x%x > caf=0x%x\n",var,caf);)+            searchCAFResult(caf,var,arity,mostRecentHidden);+          }+        }+        break;+    case ExpProjection:+        HIDE(fprintf(stderr,"searchCAF: found ExpProjection\n");)+        if (hasSrcPos(c)) { readFO(); }+        { FileOffset result;+          readFO();	/* parent */+          result = readFO();+          searchCAFResult(caf,result,arity,mostRecentHidden);+        }+        break;+    case ExpHidden:+        HIDE(fprintf(stderr,"searchCAF: found ExpHidden\n");)+        { FileOffset result;+          readFO();	/* parent */+          result = readFO();+          searchCAFResult(caf,result,arity,value);+        }+        break;+    case ExpForward:+        HIDE(fprintf(stderr,"searchCAF: found ExpForward\n");)+        { FileOffset result;+          result = readFO();+          searchCAFResult(caf,result,arity,mostRecentHidden);+        }+        break;+    case AtomVariable:+        readFO();	/* skip module pointer */+        { int x; fread(&x,sizeof(int),1,HatFileRandom); }   /* skip line/col */+        { int x; fread(&x,sizeof(int),1,HatFileRandom); }   /* skip line/col */+        { char x; fread(&x,sizeof(char),1,HatFileRandom); } /* skip fixity */+        { unsigned char size;+          char *id;+          fread(&size,sizeof(unsigned char),1,HatFileRandom);+          id = readString();+          HIDE(fprintf(stderr,"searchCAF: found AtomVariable %s\n",id);)+          if (!strcmp(id,o_callee) && (arity<size)) {+            insert_mapAtom2Info(value,id,(o_arity>size ? o_arity : size));+              HIDE(fprintf(stderr,"searchCAF: STORING caf=0x%x var=%s, size=%d\n",caf,id,arity);)+            insert_map2(mapExp2Atom,caf,value,arity);+          }+          if (o_context && !strcmp(id,o_caller) && (arity<size)) {+            insert_mapAtom2Info(value,id,size);+            insert_map2(mapContext2Atom,caf,value,arity);+          }+        }+        break;+    default:+        HIDE(fprintf(stderr,"searchCAF: found something else\n");)+        break;+  }+  return;+}+
+ tools/observeutils.h view
@@ -0,0 +1,45 @@+#ifndef _OBSERVEUTILS_H+#define _OBSERVEUTILS_H++#include "art.h"+#include "finitemap.h"++extern Bool hat_interrupted;+void ctrlC (int);++/* Some finite maps (i.e. lookup tables). */+extern FiniteMap mapAtom2Info, mapExp2Atom, mapContext2Atom;++/* mapAtom2Info :: FileNode -> Info */+typedef struct {+  FileOffset    node;+  unsigned char arity;+  char*         var;+} Info;+/* mapExp2Atom, mapContext2Atom :: FileNode -> Atom */+typedef struct {+  FileOffset    atom;+  unsigned char arity;+} Atom;+++/* Insert into finite maps */+void		insert_mapAtom2Info	(FileOffset atom, char* var+					,unsigned char arity);+void		insert_map2		(FiniteMap map2, FileOffset exp+					,FileOffset atom, unsigned char arity);+/* Routines visible from Haskell world */+void		setObserveContext	(Bool hascontext, Bool rec, int arity+					,char* caller);+FileOffset	lookForFirstApp		(char* callee);+FileOffset	lookForFirstSrc		(int line, int col, char* module);+FileOffset	nextObservation		(FileOffset seen);++/* Internal routines */+FileOffset	varSearch		(void);+FileOffset	srcSearch		(void);+void		searchCAFResult		(FileOffset caf, FileOffset result+					,unsigned char arity+					,FileOffset mostRecentHidden);++#endif
+ tools/parentset.c view
@@ -0,0 +1,72 @@+#include "art.h"+#include "parentset.h"+#include <stdio.h>+#include <stdlib.h>++#ifdef DEBUG+void+showParentSet (ParentSet* ps)+{+  int i;+  fprintf(stderr,"ParentSet { trueParent=0x%x, numOthers=%d, sizeOthers=%d\n",ps->trueParent,ps->numOthers,ps->sizeOthers);+  fprintf(stderr,"          , others=0x%x\n",ps->others);+  for (i=0; i < ps->numOthers; i++) {+    fprintf(stderr,"          , others[%d]=0x%x\n",i,ps->others[i]);+  }+  fprintf(stderr,"          } @ 0x%x\n",ps);+}+#define HIDE(x) x+#else+#define HIDE(X)+#endif++ParentSet*+newParentSet (FileOffset p)+{+  ParentSet* ps = (ParentSet*)malloc(sizeof(ParentSet));+  ps->trueParent = p;+  ps->numOthers  = 0;+  ps->sizeOthers = 0;+  ps->others     = 0;+  return ps;+}++void+extendParentSet (ParentSet* ps, FileOffset p)+{+  if (ps->numOthers == ps->sizeOthers) {+    ps->sizeOthers += CHUNK_OTHER_PARENTS;+    ps->others = (FileOffset*)realloc(ps->others+                                     ,ps->sizeOthers * sizeof(FileOffset));+    if (ps->others==0) fprintf(stderr,"extendParentSet: realloc failed\n");+  }+  HIDE(fprintf(stderr,"extendParentSet: num=%d, size=%d, new p=0x%x\n",ps->numOthers,ps->sizeOthers,p);)+  ps->others[ps->numOthers] = p;+  ps->numOthers += 1;+}++void+freeParentSet (ParentSet* ps)+{+  if (ps->sizeOthers > 0) free(ps->others);+  free(ps);+}++FileOffset+trueParent (ParentSet* ps)+{+  if (ps) return ps->trueParent; else return 0;+}++Bool+elemParentSet (FileOffset p, ParentSet* ps)+{+  int i;+  if (!ps) { return False; }+  if (p == ps->trueParent) { return True; }+  for (i=0; i < ps->numOthers; i++) {+    if (p == ps->others[i]) return True;+  }+  return False;+}+
+ tools/parentset.h view
@@ -0,0 +1,22 @@+#ifndef _PARENTSET_H+#define _PARENTSET_H++#include "art.h"++#define CHUNK_OTHER_PARENTS 10++typedef struct {+    FileOffset  trueParent;+    int         numOthers;+    int         sizeOthers;+    FileOffset* others;+} ParentSet;++/* prototypes */+ParentSet*	newParentSet	(FileOffset p);+void		freeParentSet	(ParentSet* ps);+void		extendParentSet	(ParentSet* ps, FileOffset p);+FileOffset	trueParent	(ParentSet* ps); +Bool		elemParentSet	(FileOffset p, ParentSet* ps);++#endif
+ tools/pathutils.c view
@@ -0,0 +1,47 @@+#include <string.h>++char*+rmext (char* word, char* ext)+{+  if (ext==(char*)0) return word;+  else {+    char *e = ext;+    char *i = strdup(word);+    char *c = i;+    while (*c) c++;+    while (*e) e++;+    while ((*--c==*--e) && e!=ext) ;+    if ((e==ext) && (*c==*e)) *c='\0';+    return i;+  }+}++char*+basename (char* path, char* ext)+{+  char *c = path;+  while (*c) c++;+  while (*c!='/' && c!=path) c--;+  if (c==path) return rmext(path,ext);+  else {+    c++;+    return rmext(strdup(c),ext);+  }+}++char*+dirname (char* path)+{+  char *start, *c;+  start = strdup(path);+  c = start;+  while (*c) c++;+  while (*c!='/' && c!=start) c--;+  if (c==start) {+    return ".";+  } else {+    *c='\0';+    return start;+  }+}+
+ tools/pathutils.h view
@@ -0,0 +1,8 @@+#ifndef _PATHUTILS_H+#define _PATHUTILS_H++char* rmext (char* word, char* ext);+char* basename (char* path, char* ext);+char* dirname (char* path);++#endif
+ tools/stack.h view
@@ -0,0 +1,12 @@+typedef struct stack_s+{+    void *element;+    struct stack_s *next;+} stack;++stack* stack_newEmptyStack();+stack* stack_newByCopyingStack(stack* theStack);+void stack_delete(stack* theStack);+void* stack_pop(stack* theStack);+void stack_push(stack* theStack, void *element);+int stack_size(stack* theStack);
+ tools/ystrings.h view
@@ -0,0 +1,5 @@+/* append strings and reserve space for the result string */+char* catStr (char* s1, char* s2, char* s3);++/* replace string in s with the concatenation of s1,s2 and s3 */+void replaceStr(char** s,char* s1,char *s2,char* s3);
+ trans/AuxFile.hs view
@@ -0,0 +1,569 @@+module AuxFile+  ( module AuxFile	-- internals used by module AuxLabelAST+  ) where+ -- toAuxFile		-- primary export used by Main+			-- hbc won't let me put both specs in the export list+++import Control.Monad(when)+import System.IO(hPutStr,stderr)+import Data.Maybe(isNothing,fromJust)+import Data.List(isPrefixOf,nub,minimumBy,elemIndex)++import Syntax+import TokenId (TokenId(..),tPrelude,visImport,t_Tuple,getUnqualified,t_Arrow)+import SysDeps(PackedString, unpackPS, packString)+import AssocTree+import OsOnly+import Flags+import Extra (noPos, readFirst)+import AuxTypes+import AuxFixity (fixInfixList)++import Extra (strace)+import AssocTree++-- `toAuxFile' writes out the .hx file given this module's complete+-- parse tree.  The .hx file mentions all exported identifiers, both+-- those defined in this module, and those reexported from imports.++toAuxFile :: Environment -> Flags -> FilePath -> Module TokenId -> IO ()+toAuxFile finalEnv flags aux+          (Module pos modid exports imports fixdecls (DeclsParse decls)) =+  do+    let (identMap,definedTypesAndClasses) = mkIdentMap decls+    let (_,definedExported) = +          extendEnv finalEnv (initAuxInfo (not (sDbgTrusted flags))) +            (visibleIn exports unspecYes modid)+            (initAT,identMap)+	    (map DeclFixity fixdecls ++ decls)+    ((fullInfo,fullIdentMap),_) <- getImports (visibleIn exports unspecNo)+					  definedExported+                                          flags imports+    writeFile aux ((showString "module " . shows modid . showChar '\n' .+                    showLines (listAT fullInfo)+                   ) "")+    {- This warning should be harmless and is just irritating for the user+    let missingDefns = missing exports (fullInfo,fullIdentMap)+			       definedTypesAndClasses+    when (not (null missingDefns))+         (hPutStr stderr+            ((showString "\nExported but not defined in this module "+		. showString "(possibly imported and reexported):\n"+		. showLines missingDefns) "\n"))+    -}+  where+    showLines :: Show a => [a] -> ShowS+    showLines = foldr (\x y-> shows x . showChar '\n' . y) id+++-- `getImports' sucks in the .hx files for all explicit imports,+-- following the impspec carefully with regard to explicit naming and+-- hiding.  We take a kind of need-analysis as the `reexport' argument,+-- to determine more accurately which entities are really vital to+-- import and which to ignore.  ++getImports :: (TokenId->Visibility) -> Environment+	   -> Flags -> [ImpDecl TokenId] -> IO (Environment,[Environment])+getImports reexport (alreadyGot,identMap) flags impdecls = do+    let importFiles = map impData impdecls+        importQualifiers = map qualifiers impdecls+        importHiddenEntities = map getHidden impdecls+    auxInfos <- mapM getAuxFile importFiles+    let allInfo = zip3 importFiles importQualifiers auxInfos+    return ((foldr extendImportEnv alreadyGot allInfo+            ,foldr extendIdentMap identMap allInfo )+           ,zipWith makeEnv importHiddenEntities auxInfos)+  where+    getHidden (Import _ (Hiding entities)) = entities+    getHidden (ImportQ _ (Hiding entities)) = entities+    getHidden (ImportQas _ _ (Hiding entities)) = entities+    getHidden (Importas _ _ (Hiding entities)) = entities+    getHidden _ = []++    qualifiers (Import m _)      = ["", show m++"."]+    qualifiers (ImportQ m _)     = [show m++"."]+    qualifiers (ImportQas m n _) = [show n++"."]+    qualifiers (Importas m n _)  = ["", show n++"."]++    makeEnv :: [Entity TokenId] -> [(Identifier,AuxiliaryInfo)] -> Environment+    makeEnv entities auxInfos =+      foldr addEnv (initAT,initAT) auxInfos+      where+      addEnv :: (Identifier,AuxiliaryInfo) -> Environment -> Environment+      addEnv (identifier,auxInfo) (auxTree,idMap) =+        if identifier `isAmong` entities+          then (if notTyCls identifier+                  then (addAT auxTree const identifier auxInfo+                       ,addAT idMap const (subTid identifier) identifier) +                  else (addTyCls (\x->True) auxTree identifier auxInfo,idMap)) +          else (auxTree,idMap)++    normalImport modid = +      not (sPrelude flags && "TraceOrig" `isPrefixOf` getUnqualified modid)+      +    getAuxFile :: (TokenId,Visibility) -> IO [(Identifier,AuxiliaryInfo)]+    getAuxFile (modid,importVisible) = +      if normalImport modid +        then do+        (_,f) <- readFirst (fixImportNames (sUnix flags) "hx" (show modid)+                                           (sIncludes flags ++ sPreludes flags))+	(return . map (myRead (show modid)) . tail . lines) f+        else return []++    extendImportEnv ((modid,importVisible), qs, auxInfos) got =+        foldr (\ (k,v) t-> let ks = map (qual k) qs in	-- all qual names+            foldr (\k' t-> if notGot k' t && importVisible k {-not! k'-}+                              && reexport modid k'+                           then (if notTyCls k'+                                     then addAT t const k' v+                                     else addTyCls importVisible t k' v)+                           else t) t ks+              ) got auxInfos++    extendIdentMap ((modid,importVisible), _, auxInfos) got =+        foldr (\(k,_) t-> let i  = subTid k in+                          if notTyCls k && notGot i t && importVisible k +                            && reexport modid k+                          then addAT t const i k else t) got auxInfos++    addTyCls :: Visibility -> AuxTree -> Identifier -> AuxiliaryInfo -> AuxTree+    addTyCls importVisible t k@(TypeClass tyCls) (TyCls v') =+      addAT t const k +        (case v' of+          Ty cons labels -> +            TyCls (Ty (filter (importVisible . Con undefined tyCls) cons) +                      (filter (importVisible . Field tyCls) labels))+          Syn helpers body -> TyCls (Syn helpers body)+          Cls methods -> +            TyCls (Cls (filter (importVisible . Method tyCls) methods)))++    notTyCls (TypeClass _) = False+    notTyCls _ = True++    notGot k t = case lookupAT t k of { Nothing -> True; Just _ -> False }++ -- getModule (Import (_,modid) is) = modid+ -- getModule (ImportQ (_,modid) is) = modid + -- getModule (ImportQas (_,modid) _ is) = modid+ -- getModule (Importas (_,modid) _ is)  = modid++    impData (Import (_,modid) is)      = (modid, impSpec is)+    impData (ImportQ (_,modid) is)     = (modid, impSpec is)+    impData (ImportQas (_,modid) _ is) = (modid, impSpec is)+    impData (Importas (_,modid) _ is)  = (modid, impSpec is)++    impSpec :: ImpSpec TokenId -> Visibility+    impSpec (Hiding [])         = (\x-> True)+    impSpec (Hiding entities)   = (\x-> not (x `isAmong` entities))+    impSpec (NoHiding entities) = (\x-> x `isAmong` entities)++    x `isAmong` entities = (x `match`) `any` entities++    (Var v)     `match` (EntityVar _ y)        =  v  == show y+    (Field t1 f)`match` (EntityVar _ y)        =  f  == show y+    (Method c m)`match` (EntityVar _ y)        =  m  == show y+    (Con _ t1 c)`match` (EntityConClsAll _ t2) =  t1 == show t2+    (Field t1 f)`match` (EntityConClsAll _ t2) =  t1 == show t2+    (Method c m)`match` (EntityConClsAll _ c2) =  c  == show c2+    (Con _ t1 c)`match` (EntityConClsSome _ t2 cs) =+				t1 == show t2 && c `elem` (map (show.snd) cs)+    (Field t1 f)`match` (EntityConClsSome _ t2 cs) =+				t1 == show t2 && f `elem` (map (show.snd) cs)+    (Method c m)`match` (EntityConClsSome _ c2 ms) =+				c  == show c2 && m `elem` (map (show.snd) ms)+    (TypeClass tc1) `match` (EntityConClsAll _ tc2) = tc1 == show tc2+    (TypeClass tc1) `match` (EntityConClsSome _ tc2 _) = tc1 == show tc2+    _           `match`  _                     =  False++-- better error message+myRead :: (Read a) => String -> String -> a+myRead file s =  +  case [x | (x,t) <- reads s, ("","") <- lex t] of+    [x] -> x+    bs@[]  -> error ("Cannot parse in .hx file " ++ file ++ " line " ++ s)+--                   (minimumBy (\v w -> compare (length v) (length w)) +--                     [t | (x,t) <- reads s, let dummy = x:bs]))+    y   -> error ("Ambiguous parse of .hx file " ++ file)++-- Visibility is a function denoting whether an identifier should be+-- added (or not) to the AuxTree structure.+type Visibility = Identifier -> Bool++-- `visibleIn' is a particular kind of visibility, determined+-- by the explicit exports of the module.++-- When checking Constructors, we need to check both whether it+-- is mentioned explicitly, and whether the type it belongs to it+-- mentioned in Typ(..) syntax, which implicitly exports all its+-- constructors.  Likewise for fields, and for methods with the+-- Class(..) syntax.++visibleIn :: Maybe [Export TokenId] -> Visibility -> TokenId -> Visibility+visibleIn Nothing noneSpecified modid = (\_->False)+visibleIn (Just exports) noneSpecified modid+  | null exports = noneSpecified+  | any (implicitAll modid) exports = (\_->True)+  | otherwise = idFilter+  where+    implicitAll modid (ExportModid _ m) | m==modid = True+    implicitAll _ _ = False++    explicitVars = concatMap+	 (\e-> case e of+		ExportEntity _ (EntityVar _ e) ->[show e]+		_ -> []) exports++    explicitSubordinates = concatMap+	 (\e-> case e of+		ExportEntity _ (EntityConClsSome _ _ sub) -> map (show.snd) sub+		_ -> []) exports++    implicitSubordinates = concatMap+	 (\e-> case e of+		ExportEntity _ (EntityConClsAll _ torc) -> [show torc]+		_ -> []) exports++    explicitTyClss = concatMap+         (\e-> case e of+                ExportEntity _ (EntityConClsSome _ tyCls _) -> [show tyCls]+                ExportEntity _ (EntityConClsAll _ tyCls) -> [show tyCls]+                _ -> []) exports ++    idFilter c@(Con _ typ con)    =  con `elem` explicitSubordinates+				|| typ `elem` implicitSubordinates+    idFilter v@(Var var)        =  var `elem` explicitVars+    idFilter v@(Method cls met) =  met `elem` explicitSubordinates+				|| cls `elem` implicitSubordinates+				|| met `elem` explicitVars+    idFilter c@(Field typ f)    =  f   `elem` explicitSubordinates+				|| typ `elem` implicitSubordinates+				|| f   `elem` explicitVars+    idFilter (TypeClass tyCls) = tyCls `elem` explicitTyClss+++-- If it is left unspecified whether an entity is exported (due to+-- a declaration like `module M where'), the entity's visibility+-- in the true exports depends on whether the entity was defined here or+-- merely imported.  Defined entities are exported, imported ones are not.+unspecYes, unspecNo :: Visibility+unspecYes = \_->True+unspecNo  = \_->False+++-- `extendEnv' extends an AuxTree environment from a list of declarations,+-- filtered for `visibility' by some criterion.  For instance, when writing+-- the .hx file, we take care only to include identifiers that are visible+-- via the export declarations.  But when traversing the syntax tree to+-- resolve fixity conflicts and label it with arity information, the local+-- environment of identifiers is built with all identifiers in scope visible.++extendEnv :: Environment -> InitAuxInfo -> Visibility -> Environment +          -> [Decl TokenId] -> ([TokenId],Environment)+extendEnv finalEnv iai visible (init,identMap) decls = +  (irrefutableIds,(env,identMap))+  where+  (irrefutableIds,env) = +     foldrPat (auxInfo finalEnv iai visible identMap) init decls+                -- pass final environment as argument+++-- auxInfo is the main gatherer of information about declarations.+-- It decides what AuxiliaryInfo to attach to each Identifier in+-- the environment.+-- It does not recursively descend to local declarations.+auxInfo :: Environment +        -> InitAuxInfo -> Visibility -> IdentMap -> Decl TokenId -> AuxTree +        -> ([TokenId],AuxTree)+-- Add varid/varop identifier, with arity.+auxInfo env iai visible identMap (DeclFun _ f clauses) t+    | visible key  = ([],addAT t replaceArity key ((emptyAux iai){args = a}))+    where a   = let (Fun pats rhs local) = head clauses in length pats+          key = Var (show f)+-- Add varop identifier declared in infix equation, with arity.+auxInfo env iai visible identMap +  (DeclPat (Alt pat@(ExpInfixList _ es) rhs local)) t+    | len >= 3  =+	let (_:defn:_) = es in+	case defn of+	  ExpVarOp _ f -- actually a function definition+	    | visible key -> +              ([],addAT t replaceArity key ((emptyAux iai){args=len-1}))+						where key = Var (show f)+	  _ -> (\(i,(e,m)) -> ([],e)) $ +                addPat iai Irrefutable visible pat (t,identMap)+    where len = length es+-- Add varid identifiers declared in a pattern binding.+auxInfo env iai visible identMap (DeclPat (Alt pat rhs local)) t =+    (\(i,(e,m)) -> ([],e)) $ addPat iai Irrefutable visible pat (t,identMap)+-- Add varid identifier declared as a primitive, with arity.+auxInfo env iai visible identMap (DeclPrimitive _ f a _) t+    | visible key  = ([],addAT t replaceArity key ((emptyAux iai){args = a}))+						where key = Var (show f)+-- Add varid identifier declared as a foreign import, with arity.+auxInfo env iai visible identMap (DeclForeignImp _ _ _ f a _ _ _) t+    | visible key  = ([],addAT t replaceArity key ((emptyAux iai){args = a}))+						where key = Var (show f)+-- Add type, constructor, with arity, and any associated field names.+auxInfo env iai visible identMap (DeclData sort _ (Simple _ typ _) tycons _) t =+  ([],addAT (foldr doCon t tycons) const +        (TypeClass sTyp) (TyCls (Ty constructors fieldlabels)))+  where+    sTyp = show typ+    constructors = +      filter (visible . Con undefined sTyp) . map (show . getConstrId) $ tycons+    fieldlabels = +      filter (visible . Field sTyp) . map show . nub . map snd . +        concatMap getConstrLabels $ tycons+    doCon (Constr _ c fs) t	   = accept c fs (foldr doFields t fs)+    doCon (ConstrCtx _ _ _ c fs) t = accept c fs (foldr doFields t fs)+    accept con fs t+	| visible key = addAT t replaceArity key ((emptyAux iai){args=a})+	| otherwise = t+	where a = sum (map (\(mb,_)->maybe 1 length mb) fs)+	      key = Con (if isNothing sort then Newtype else Data) +                      (show typ) (show con)+    doFields (Nothing,_) t = t+    doFields (Just fs,_) t = foldr doField t fs+    doField (_,f) t+        | visible key = addAT t replaceArity key ((emptyAux iai){args=1})+	| otherwise = t+	where key = Field (show typ) (show f)+-- Add type synonym+auxInfo env _ visible identMap (DeclType (Simple _ ty args) body) t =+  ([],addAT t const (TypeClass (show ty)) +       (TyCls (splitSynonym env (map snd args) body)))+-- Add class and class method identifier, arity is always -1.+auxInfo env iai visible identMap (DeclClass _ _ cls _ _ (DeclsParse decls)) t =+  ([],addAT (foldr doMethod t decls) const+        (TypeClass sCls) (TyCls (Cls methods)))+  where+    sCls = show cls+    methods =+      filter (visible . Method sCls) . map show . concatMap getMethods $ decls+    getMethods (DeclVarsType posIds _ _) = map snd posIds+    getMethods _ = []+    doMethod (DeclVarsType pis ctxs typ) env = foldr pId env pis+    doMethod (DeclFixity f) env = fixInfo iai visible identMap f env+    doMethod _ env = env+    pId (pos,meth) t | visible key = addAT t replaceArity key (emptyAux iai)+		     | otherwise = t+		     where key = Method (show cls) (show meth)+-- Add normal infix decl for identifier.+auxInfo env iai visible identMap (DeclFixity f) t = +  ([],fixInfo iai visible identMap f t)+-- No other form of decl matters.+auxInfo env _ visible identMap _ t = ([],t)+--auxInfo visible identMap (DeclTypeRenamed _ _) t =+--auxInfo visible identMap (DeclDataPrim _ _ _) t =+--auxInfo visible identMap (DeclConstrs _ _ _) t =+--auxInfo visible identMap (DeclInstance _ _ _ _ _) t =+--auxInfo visible identMap (DeclDefault _) t =+--auxInfo visible identMap (DeclForeignExp _ _ _ _) t =+--auxInfo visible identMap (DeclVarsType _ _ _) t =+--auxInfo visible identMap (DeclIgnore _) t =+--auxInfo visible identMap (DeclError _) t =+--auxInfo visible identMap (DeclAnnot _ _) t =+++-- Add fixity info for identifier.  Here, we can encounter a constructor+-- without its parent type, or a method without its parent class, and+-- thus need to reconstruct its parent by looking in the IdentMap.++fixInfo :: InitAuxInfo -> Visibility -> IdentMap -> FixDecl TokenId +        -> AuxTree -> AuxTree+fixInfo iai visible identMap (fixclass,prio,ids) t =+    foldr (\name t -> let key = useIdentMap identMap name in+                      if visible key +                        then addAT t replaceInfix key+			       ((emptyAux iai){priority=prio,fixity=f})+                        else t)+          t+          (map stripFixId ids)+  where+    f = case fixclass of+          InfixDef   -> Def+          InfixL     -> L+          InfixR     -> R+          Infix      -> None+          InfixPre f -> Pre (show f)+++-- different ways of combining new item into AuxTree where item already exists+replaceArity, replaceInfix :: AuxiliaryInfo -> AuxiliaryInfo -> AuxiliaryInfo+replaceArity new old = new { priority = priority old, fixity = fixity old} +  -- old { args = args new }+replaceInfix new old = old { priority = priority new, fixity = fixity new }+++-- `missing' determines a list of exported identifiers that were+-- apparently neither defined in this module nor imported/reexported.+-- In fact, it falsely accuses reexported types and classes at the+-- moment.+missing :: Maybe [Export TokenId] -> Environment -> [TokenId] -> [Identifier]+missing Nothing (defined,identMap) definedTypes = []+missing (Just exports) (defined,identMap) definedTypes =+    concatMap notDefined exports+  where+    notDefined (ExportEntity _ (EntityVar _ v))       = valNotDefined v+    notDefined (ExportEntity _ (EntityConClsAll _ t)) = typNotDefined t+    notDefined (ExportEntity _ (EntityConClsSome _ t cs)) =+				concatMap (valNotDefined . snd) cs+    notDefined _ = []++    valNotDefined m = let v = useIdentMap identMap m in+                      case lookupAT defined v of+                          Just _ -> []+                          Nothing -> [v]++    typNotDefined typ = if typ `elem` definedTypes then []+			else [Con Data (show typ) ".."]+++-- Extending environment from handling of patterns++data PatSort = Refutable | Irrefutable++foldrPat :: (a -> env -> ([b],env)) -> env -> [a] -> ([b],env)+foldrPat f env pats = (foldr combinePat ((,) []) . map f $ pats) env++combinePat :: (env -> ([b],env)) -> (env -> ([b],env)) -> (env -> ([b],env)) +combinePat f g env = (fbs++gbs,fenv)+  where+  (gbs,genv) = g env+  (fbs,fenv) = f genv+  ++-- `addPat' extends the environment with a lambda-bound variable+-- (e.g. pattern).  Visibility is only important in the exported aux file.+-- A variable in a refutable pattern becomes lambda-bound in the environment,+-- a variable in an irrefutable pattern becomes let-bound;+-- the latter variables are returned as first part of the result.+addPat :: InitAuxInfo -> PatSort -> Visibility -> Pat TokenId -> Environment +       -> ([TokenId],Environment)+addPat iai patSort visible pat (env,identMap) = +  (refutableVars,(newEnv,identMap))+  where+  (refutableVars,newEnv) = ap patSort pat env+  ap :: PatSort -> Pat TokenId -> AuxTree -> ([TokenId],AuxTree)+  ap s (ExpRecord (ExpCon p id) fields) env = foldrPat (addField s) env fields+  ap Refutable pat@(ExpApplication p ((ExpCon _ id):exps)) env +    | isIrrefutable pat = foldrPat (ap Irrefutable) env exps+  ap s (ExpApplication _ exps) env = foldrPat (ap s) env exps+  ap s (ExpVar p id) env = extendEnvPat s id env+  ap s (ExpCon p id) env = ([],env)+  ap s (ExpList p exps) env = foldrPat (ap s) env exps+  ap s (PatAs p id pat) env = (ap s pat `combinePat` extendEnvPat s id) env+  ap s (PatIrrefutable p pat) env  = ap Irrefutable pat env+  ap s (PatNplusK p id1 id2 exp1 exp2 exp3) env = +    ([],addAT env letBound key ((patternAux iai){letBound=True,args=0}))+    where+    key = Var (show id1)+    -- variable shall be let bound+  ap s (ExpInfixList p exps) env = ap s (fixInfixList (env,identMap) exps) env+  -- ap s (ExpVarOp p id) env = extendEnvPat s id env+  -- ap s (ExpConOp p id) env = env+  ap _   _ env = ([],env)++  addField s (FieldExp p id exp) env = ap s exp env+  addField s (FieldPun p id) env     = extendEnvPat s id env++  extendEnvPat :: PatSort -> TokenId -> AuxTree -> ([TokenId],AuxTree)+  extendEnvPat Refutable id env +    | visible key = ([],addAT env lambdaBound key (patternAux iai))+    where+    key = Var (show id)+  extendEnvPat Irrefutable id env +    | visible key = +      ([id],addAT env letBound key ((patternAux iai){letBound=True,args=0}))+    where+    key = Var (show id)+  extendEnvPat _ _ env = ([],env)++  lambdaBound new old = old { letBound=False, args= -1 }+  letBound new old = old { letBound=True, args=0 }++  isIrrefutable :: Pat TokenId -> Bool+  isIrrefutable (ExpApplication pos pats) = and . map isIrrefutable $ pats+  isIrrefutable (ExpCon _ id) = isNewTypeDataCon id+  isIrrefutable (ExpVar _ _) = True+  isIrrefutable (PatAs _ _ pat) = isIrrefutable pat+  isIrrefutable (PatIrrefutable _ _) = True+  isIrrefutable (ExpRecord (ExpCon _ id) fieldPats) =+    and . (isNewTypeDataCon id :) . map isIrrefutableField $ fieldPats+    where+    isIrrefutableField (FieldExp _ _ pat) = isIrrefutable pat+  isIrrefutable _ = False++  isNewTypeDataCon id = case lookupAT identMap id of+    Just (Con Newtype _ _) -> True+    Just (Con Data _ _) -> False+    _ -> False -- needed to handle e.g. Prelude.[]+    -- _ -> error ("Data constructor not in scope: " ++ show id)+++-- determines the outer functional or applicative part of a type synonym body+-- this part can then be expanded when transforming types for workers+-- the *final* environment is needed, because in the body of a type synonym+-- a type synonym may appear; because type synonyms shall not be recursive,+-- a blackhole cannot occur for type correct programs.+splitSynonym :: Environment -> [TokenId] -> Type TokenId -> TyCls+splitSynonym env tyVars rhs = +  case go rhs of+    Syn 1 THelper -> Syn 0 THelper -- nothing to split off (bogus THelper)+    syn -> syn+  where+  -- it is vital that this `go' agrees with the `go' in `splitSynonym' in+  -- TraceTrans.+  go :: Type TokenId -> TyCls+  go (TypeCons _ tyCon tys) +    | getUnqualified tyCon == "->" = +      case tys of+        [] -> Syn 0 TFun+        [ty] -> Syn 1 (TApp TFun THelper)+        [ty1,ty2] -> let Syn h ty2' = go ty2 +                     in Syn (h+1) (TApp (TApp TFun THelper) ty2')+    | isExpandableTypeSynonym info = go (expandTypeSynonym info tyCon tys)+    where+    info = lookupTyCls env tyCon+  go (TypeApp ty1 ty2) = Syn (h1+h2) (TApp ty1' ty2')+    where+    Syn h1 ty1' = go ty1+    Syn h2 ty2' = go ty2+  go (TypeVar _ tyVar) = Syn 0 (TVar (fromJust (elemIndex tyVar tyVars)))+  go _ = Syn 1 THelper+++isExpandableTypeSynonym :: Maybe AuxiliaryInfo -> Bool+isExpandableTypeSynonym (Just (TyCls (Syn n _))) = n > 0+isExpandableTypeSynonym _ = False++expandTypeSynonym :: Maybe AuxiliaryInfo +                  -> TokenId -> [Type TokenId] -> Type TokenId+expandTypeSynonym (Just (TyCls (Syn n body))) tySyn tys = fst (go body 1)+  where+  go :: TySynBody -> Int -> (Type TokenId,Int)+  go THelper n = +    (TypeCons noPos (nameTransTySynHelper tySyn n) tys+    ,n+1)+  go (TVar v) n = (tys!!v,n)+  go TFun n = (TypeCons noPos t_Arrow [],n)+  go (TApp ty1 ty2) n = (TypeApp ty1' ty2',n2)+    where+    (ty1',n1) = go ty1 n+    (ty2',n2) = go ty2 n1++nameTransTySynHelper :: TokenId -> Int -> TokenId+nameTransTySynHelper tySyn no = updateToken tySyn (++ ("___" ++ show no))++updateToken :: TokenId -> (String -> String) -> TokenId+updateToken (Visible n) f = +  Visible (packString . reverse . f . unqual $ n) +updateToken (Qualified m n) f =+  Qualified m (packString . reverse . f . unqual $ n)+ +unqual :: PackedString -> String+unqual = reverse . unpackPS++lookupTyCls :: Environment -> TokenId -> Maybe AuxiliaryInfo+lookupTyCls (auxTree,_) id = lookupAT auxTree (TypeClass (show id))
+ trans/AuxFixity.hs view
@@ -0,0 +1,224 @@+{- ---------------------------------------------------------------------------+Restructure expressions with infix operators according to associativity+and precedence.  This variant of the infix resolution code is only+used when performing the tracing transformation.  When doing ordinary+compilation, resolving infix expressions is part of the Rename phase.+-}++module AuxFixity(fixInfixList) where++import SysDeps(PackedString,packString,unpackPS)+import Extra(Pos(..),noPos,strPos,pair)+import Syntax+import SyntaxPos+import TokenId(TokenId(..), t_x, t_y, t_flip, t_minus, tnegate, visImport)+import AssocTree+--import PreImp+import AuxTypes+import MkSyntax(mkAppExp)+++{-+-- Main function of the module.+-}+fixInfixList :: Environment -> [Exp TokenId] -> Exp TokenId++fixInfixList env [] = error "I: fixInfix []"+fixInfixList env ees@(ExpVarOp pos op:es) =+  let fix = lookupFix env op+      exp' = reorder env es+      exp  = invertCheck pos op fix env exp'+--in ExpLambda pos [varx,vary] +--                  (ExpApplication pos [ExpVar pos op,vary,varx])+--  where+--  varx = ExpVar pos t_x+--  vary = ExpVar pos t_y+  in if op == t_minus+     then reorder env ees+     else (mkAppExp [ExpVar noPos t_flip, ExpVar pos op, exp])+             -- desugaring with flip better than lambda for reading a trace+fixInfixList env ees@(ExpConOp pos op:es) =+  let fix = lookupFix env op+  in case fix of+	(Pre a,l) -> reorder env ees+	_ -> let exp' = reorder env es+                 exp  = invertCheck pos op fix env exp'+--           in ExpLambda pos [varx,vary] +--                  (ExpApplication pos [ExpVar pos op,vary,varx])+--  where+--  varx = ExpVar pos t_x+--  vary = ExpVar pos t_y+             in mkAppExp [ExpVar noPos t_flip, ExpCon pos op, exp]+             -- desugaring with flip better than lambda for reading a trace+fixInfixList env ees =+  case last ees of+    ExpConOp pos op -> let fix  = lookupFix env op+			   exp' = reorder env (init ees)+                           exp  = invertCheck pos op fix env exp'+                       in (mkAppExp [ExpCon pos op,exp])+    ExpVarOp pos op -> let fix  = lookupFix env op+			   exp' = reorder env (init ees)+                           exp  = invertCheck pos op fix env exp'+                       in (mkAppExp [ExpVar pos op,exp])+    _ -> reorder env ees++++-- the primary function that re-orders an infix list into a single expression+reorder :: Environment -> [Exp TokenId] -> Exp TokenId+reorder env es = getExp env [] [] es+++-- getExp and getOp together `parse' the list of expressions into a+-- single tree-shaped expression.  We expect the list to take the form+-- [exp,op,exp,op,exp,op...] i.e. exps and ops alternate.  Of course,+-- there are exceptions: where the whole expr is a left or right section+-- of an operator; and where a prefix operator starts the show.++getExp :: Environment			-- environment (contains fixity info)+	-> [((Fixity,Int),(Exp TokenId,Int))] -- stack of operators already seen+	-> [Exp TokenId]		-- stack of outstanding non-op exprs+	-> [Exp TokenId]		-- input list of exprs+	-> Exp TokenId			-- re-combined output++getExp env ops exps (e:es) =+  case e of+    ExpConOp pos o ->+      let fix = lookupFix env o in+        case fix of+	  (Pre a,l) -> getExp env (stackPrefix fix (ExpCon pos o):ops) exps es+    ExpVarOp pos o ->+      let fix = lookupFix env o in+        case fix of+	  (Pre a,l) -> getExp env (stackPrefix fix (ExpVar pos o):ops) exps es+	  _ | o==t_minus+                    -> getExp env (stackPrefix (Pre "negate",6) (ExpVar pos o):ops) exps es+    _ -> getOp env ops (e:exps) es+getExp env ops [] [] =+   error ("Problem with infix section at unknown location.")+getExp env ops (e:es) [] =+   error ("Problem with infix section at "++strPos (getPos e))+++getOp :: Environment			-- environment (contains fixity info)+	-> [((Fixity,Int),(Exp TokenId,Int))]	-- stack of operators+	-> [Exp TokenId]		-- stack of outstanding non-op exprs+	-> [Exp TokenId]		-- input list of exprs+	-> Exp TokenId			-- recombined output++getOp env ops exps [] = finish ops exps+getOp env ops exps ees@(ExpConOp pos op:es) =+  case harder pos ops op env of+    Just (o,ops) -> getOp env ops (rebuild o exps) ees+    Nothing      -> let fop = stackInfix env (ExpCon pos op)+                    in getExp env (fop:ops) exps es+getOp env ops exps ees@(ExpVarOp pos op:es) =+  case harder pos ops op env of+    Just  (o,ops) -> getOp env ops (rebuild o exps) ees+    Nothing       -> let fop = stackInfix env (ExpVar pos op)+                     in getExp env (fop:ops) exps es+getOp env ops exps (e:es) =+   error ("Need infix operator at " ++ strPos (getPos e))+++stackInfix :: Environment -> Exp TokenId -> ((Fixity,Int),(Exp TokenId,Int))+stackInfix env op@(ExpVar _ o) = (lookupFix env o, (op,2::Int))+stackInfix env op@(ExpCon _ o) = (lookupFix env o, (op,2::Int))++stackPrefix fix op = (fix,(op,1::Int))+ ++-- harder decides whether a new operator has lower precedence than+-- the top of the operator stack.  If so, we can pop the stack and+-- rebuild the accumulated expression so far before continuing.+-- If however it has higher precedence, then we must push the new+-- operator onto the stack and keep going.  If it has equal precedence,+-- then left/right associativity must be taken into account.++harder :: Pos				-- position+	-> [((Fixity,Int),(b,c))]	-- stack of operators+	-> TokenId			-- operator name+	-> Environment			-- environment holding fixity info+	-> Maybe (((Fixity,Int),(b,c)),[((Fixity,Int),(b,c))])+harder pos [] op' env = Nothing+harder pos (ipop@((inf,pri),(_,_)):ops) op' env =+  let (inf',pri') = lookupFix env op' in+  if pri > pri' then+    Just (ipop,ops)+  else if pri == pri' then+    case inf of+      Def   -> Just (ipop,ops)+      L     -> Just (ipop,ops)+      Pre _ -> Just (ipop,ops)+      R     -> Nothing+      None  -> error ("Infix operator "++show op'++" at "++strPos pos+                      ++" is non-associative.")+  else Nothing++++-- finish transforms the two stacks (operators + exprs) into the final+-- recombined expression.+finish :: [((Fixity,c),(Exp TokenId,Int))]	-- stack of operators+          -> [Exp TokenId]			-- stack of non-op exprs+          -> Exp TokenId			-- output expr+finish [] []  = error "AuxFixity.finish: empty" +finish [] [e] = e+finish [] _   = error "AuxFixity.finish: multiple expression"+finish (o:ops) es = finish ops (rebuild o es)+++-- rebuild the expression stack, by combining the top two items with+-- the given operator.  Precondition: the operator must have higher+-- precedence than any operators between the exprs lower in the stack.++rebuild :: ((Fixity,c),(Exp TokenId,Int))	-- operator+           -> [Exp TokenId]			-- stack of expressions+           -> [Exp TokenId]			-- juggled the stack+rebuild (_,(op,2)) (e1:e2:es) =+        mkAppExp [op,e2,e1]:es+rebuild ((Pre fun,_) ,(op,_)) (e1:es) =+        mkAppExp [ExpVar (getPos op) (visImport fun),e1]:es+rebuild (_,(op,n)) es =+        error ("Not enough arguments at " ++ strPos (getPos op))+++-- discover fixity information from the .hx file info.+lookupFix :: Environment -> TokenId -> (Fixity,Int)+lookupFix (env,identMap) op =+    case lookupAT env (useIdentMap identMap op) of+	Just info -> (fixity info, priority info)+	Nothing   -> error ("No auxinfo for operator "++show op)+++leftFixity :: Fixity -> Bool+leftFixity L       = True+leftFixity Def     = True+leftFixity (Pre _) = True+leftFixity _       = False     		--- !!! Cheating Infix is InfixR  (??)+++-- 'invertCheck' checks for priority inversion in an operator section.+invertCheck :: Show a => Pos -> a -> (b,Int) -> Environment+		-> Exp TokenId -> Exp TokenId+invertCheck pos1 op1 (fix1,pri1) env exp =+  case exp of+    ExpApplication _ (ExpVar pos2 op2: es) -> check pos2 op2+    ExpApplication _ (ExpCon pos2 op2: es) -> check pos2 op2+    _ -> exp+  where+    check pos2 op2 =+      let (fix2,pri2) = lookupFix env op2+      in if pri2 < pri1 then+        error ("Fixity problem:\n  "+              ++show op1++" used at "++strPos pos1++" has precedence "+              ++show pri1++",\n  "+              ++show op2++" used at "++strPos pos2++" has precedence "+              ++show pri2++".\n  "+              ++"The partially applied operator "++show op1+              ++" should have lower precedence\n  "+              ++"than the fully-applied operator "+              ++show op2++" used inside the section.\n")+      else exp++{- --------------------------------------------------------------------------}
+ trans/AuxLabelAST.hs view
@@ -0,0 +1,405 @@+module AuxLabelAST+  ( auxLabelSyntaxTree+  ) where+++import Data.List (nubBy)+import Data.Char (isUpper)+import Data.Maybe (isJust)+import AuxTypes(Environment,mkIdentMap,useIdentMap,useEnvironment+               ,Identifier(..)+               ,AuxiliaryInfo(letBound),InitAuxInfo,initAuxInfo,defaultAuxInfo)+import AuxFile(Visibility,PatSort(Refutable,Irrefutable)+              ,extendEnv,getImports,addPat,foldrPat)+import AuxFixity(fixInfixList)+import TraceId+import Flags(Flags(sDbgTrusted))+import Syntax+import SyntaxUtil (infixFun)+import TokenId (TokenId(..))+import AssocTree+import Extra (Pos,noPos)+++-- `auxLabelSyntaxTree' relabels the entire abstract syntax tree,+-- replacing TokenId with TraceId (which basically adds arity and+-- binding information for each variable name).  Along the way, we+-- also need to resolve the fixity of all applications (originally+-- done in a later phase of the compiler).++auxLabelSyntaxTree :: Flags -> Module TokenId +                   -> IO (Environment,Module TraceId)+auxLabelSyntaxTree flags+	mod@(Module p modId exports imports fixdecls (DeclsParse decls)) =+  do+    let (identMap,_) = mkIdentMap decls+    (importenv,hiddenEnvs) <- +      getImports (\_->vi) (initAT,identMap) flags imports+    let (irrefutableIds,totalenv) = +          extendEnv totalenv iai vi importenv +            (map DeclFixity fixdecls ++ decls)+    let Module p modId exports imports fixdecls decls = +          relabelModule iai totalenv importenv hiddenEnvs mod+    return $ (totalenv,Module p modId exports imports fixdecls +                        (addVars iai totalenv irrefutableIds decls))+  where+  iai = initAuxInfo . not . sDbgTrusted $ flags+++-- `vi' is a degenerate visibility function.  When writing the .hx file,+-- visibility in the export list is important, but when relabeling the+-- syntax tree, everything is visible.+vi :: Visibility+vi = \_-> True+++-- `letVar' and `lookEnv' build a TraceId for any TokenId by+-- looking up the arity information in the environment.  For letVar,+-- the distinction between let-bound and lambda-bound variables+-- is decided by the caller, but for `lookEnv', it is decided by the+-- environment.+++letVar :: Environment -> TokenId -> TraceId+letVar env id =+  case useEnvironment env id of+    Just info | letBound info -> id `plus` info+    _ -> error ("AuxLabelAST.letVar: "++show id++" not let-bound in env")++lookEnv :: Environment -> TokenId -> TraceId+lookEnv env id =+  case useEnvironment env id of+    Just info -> id `plus` info+    _ -> case id of+           -- this is a horrible hack to by-pass qualified names.+           -- (only needed for use of current module as qualifier?)+           Qualified _ x -> case useEnvironment env (Visible x) of+                              Just info -> id `plus` info+                              _ -> stop+           _ -> stop+  where+  stop = error ("Variable or constructor not in scope: " ++ show id)++lookupTyCls :: Environment -> TokenId -> TraceId+lookupTyCls (auxTree,_) id =+  case lookupAT auxTree (TypeClass (show id)) of+    Just info -> id `plus` info+    Nothing -> mkTyCon defaultAuxInfo id+               -- type or class not in scope, esp. predefined ones++-- The class `Relabel' walks the abstract syntax tree, relabelling all+-- TokenId to TraceId.  Most instances are pretty trivial - the only+-- interesting ones are at the end of this section.++class Relabel g where+  relabel :: InitAuxInfo -> Environment -> g TokenId -> g TraceId++relabelModule :: InitAuxInfo -> Environment -> Environment -> [Environment] +              -> Module TokenId -> Module TraceId+relabelModule iai env impEnv hiddenEnvs +  (Module p mod Nothing imps fixs decls) =+    Module p (mkModule iai mod) Nothing +      (zipWith (relabelImports iai impEnv) hiddenEnvs imps) []+      (relabel iai env decls)+relabelModule iai env impEnv hiddenEnvs +  (Module p mod (Just exps) imps fixs decls) =+    Module p (mkModule iai mod) (Just (map (relabel iai env) exps))+      (zipWith (relabelImports iai impEnv) hiddenEnvs imps) [] +      (relabel iai env decls)+					-- fixdecls are folded into the decls++instance Relabel Export where+  relabel iai env (ExportEntity pos entity) = +    ExportEntity pos (relabel iai env entity)+  relabel iai env (ExportModid pos id)      = +    ExportModid pos (mkModule iai id)+++relabelImports iai env hiddenEnv (Import (pos,id) impspec) =+  Import (pos,mkModule iai id) (relabelImpSpec iai env hiddenEnv impspec)+relabelImports iai env hiddenEnv (ImportQ (pos,id) impspec) =+  ImportQ (pos,mkModule iai id) (relabelImpSpec iai env hiddenEnv impspec)+relabelImports iai env hiddenEnv (ImportQas (p1,id1) (p2,id2) impspec) =+  ImportQas (p1,mkModule iai id1) (p2,mkModule iai id2) +    (relabelImpSpec iai env hiddenEnv impspec)+relabelImports iai env hiddenEnv (Importas (p1,id1) (p2,id2) impspec) =+  Importas (p1,mkModule iai id1) (p2,mkModule iai id2) +    (relabelImpSpec iai env hiddenEnv impspec)++relabelImpSpec iai env hiddenEnv (NoHiding entities) = +  NoHiding (map (relabel iai env) entities)+relabelImpSpec iai env hiddenEnv (Hiding entities)   = +  Hiding (map (relabel iai hiddenEnv) entities)++instance Relabel Entity where+  relabel _ env (EntityVar p id) = +    EntityVar p (lookEnv env id)+  relabel _ env (EntityConClsAll p id) = +    EntityConClsAll p (lookupTyCls env id)+  relabel _ env (EntityConClsSome p id cons) = +    EntityConClsSome p (lookupTyCls env id) (relabelRealPosIds env cons)++instance Relabel InfixClass where+  relabel _ env InfixDef = InfixDef+  relabel _ env InfixL = InfixL+  relabel _ env InfixR = InfixR+  relabel _ env Infix  = Infix+  relabel iai env (InfixPre x) = (InfixPre (mkLambdaBound iai x))++instance Relabel FixId where+  relabel _ env (FixCon p i) = FixCon p (lookEnv env i)+  relabel _ env (FixVar p i) = FixVar p (lookEnv env i)++instance Relabel Decls where+  relabel iai env (DeclsParse decls) = DeclsParse (map (relabel iai env) decls)+  relabel iai env (DeclsScc deps)    = DeclsScc (map (relabel iai env) deps)++instance Relabel DeclsDepend where+  relabel iai env (DeclsNoRec decl) = DeclsNoRec (relabel iai env decl)+  relabel iai env (DeclsRec decls)  = DeclsRec (map (relabel iai env) decls)++instance Relabel Decl where+  relabel iai env (DeclType s typ) = +    DeclType (relabel iai env s) (relabel iai env typ)+  relabel iai env (DeclTypeRenamed p n) = DeclTypeRenamed p n+  relabel iai env (DeclData mb ctxs simp constrs pis) =+    DeclData mb (map (relabel iai env) ctxs) (relabel iai env simp)+      (map (relabel iai env) constrs) (relabelPosIds iai pis)+  relabel iai env (DeclDataPrim p i n) = -- used?+    DeclDataPrim p (mkLambdaBound iai i) n+  relabel iai env (DeclConstrs p i piis) = -- used?+    DeclConstrs p (mkLambdaBound iai i)+      (map (\(p,i1,i2)->(p,mkLambdaBound iai i1,mkLambdaBound iai i2)) piis)+  relabel iai env (DeclClass p ctxs cls vars fundeps decls) =+    DeclClass p (map (relabel iai env) ctxs) (mkClass iai cls)+      (map (mkTyVar iai) vars) (map (relabel iai env) fundeps)+      (relabel iai env decls)+  relabel iai env (DeclInstance p ctxs cls insts decls) =+    DeclInstance p (map (relabel iai env) ctxs) (mkClass iai cls)+      (map (relabel iai env) insts) (relabel iai env decls)+  relabel iai env (DeclDefault typs) =+    DeclDefault (map (relabel iai env) typs)+  relabel iai env (DeclPrimitive p i n typ) = -- used?+    DeclPrimitive p (letVar env i) n (relabel iai env typ)+  relabel iai env (DeclForeignImp p callConv str i1 n fspec typ i2) =+    DeclForeignImp p callConv str (letVar env i1) n fspec (relabel iai env typ)+      (mkLambdaBound iai i2)+  relabel iai env (DeclForeignExp p callConv str id typ) =+    DeclForeignExp p callConv str (mkLambdaBound iai id) (relabel iai env typ)+  relabel iai env (DeclVarsType pis ctxs typ) =+    DeclVarsType (relabelRealPosIds env pis) (map (relabel iai env) ctxs)+      (relabel iai env typ)+  relabel iai env (DeclPat (Alt (ExpInfixList p exps) rhs decls))+    | isJust infixFunExps +    = relabel iai env (DeclFun pos fun [Fun [e1,e2] rhs decls])+    where+    infixFunExps = infixFun exps+    Just (e1,pos,fun,e2) = infixFunExps+  relabel iai env (DeclPat (Alt pat rhs ds@(DeclsParse decls))) =+    let (irrefutableDeclIds,newEnv) = extendEnv undefined iai vi env decls+    in  DeclPat +          (Alt (relabel iai newEnv pat) (relabel iai newEnv rhs) +            (addVars iai newEnv (nubBy (\x y -> show x == show y) -- for scope +              irrefutableDeclIds) +              (relabel iai newEnv ds)))+          -- dont' use relable Alt, because that extends environment also+          -- by variables in the pattern+  relabel iai env (DeclFun p f funs) =+    DeclFun p +      -- ensure that defined id always with arity, even in class/instance+      (modArity (letVar env f) (funArity . head $ funs))+      (map (relabel iai env) funs)+  relabel _ env (DeclIgnore str) = DeclIgnore str+  relabel _ env (DeclError str) = DeclError str+  relabel iai env (DeclAnnot decl annots) =+	DeclAnnot (relabel iai env decl) (map (relabel iai env) annots)+  relabel iai env (DeclFixity (fixclass,n,fixids)) =+	DeclFixity (relabel iai env fixclass, n, map (relabel iai env) fixids)++instance Relabel Annot where+  relabel iai env (AnnotArity (p,id) n) = AnnotArity (p,mkLambdaBound iai id) n+  relabel iai env (AnnotPrimitive (p,id) pstr) = +    AnnotPrimitive (p,mkLambdaBound iai id) pstr+  relabel iai env (AnnotNeed idss) = +    AnnotNeed (map (map (mkLambdaBound iai)) idss)+  relabel _ env (AnnotUnknown) = AnnotUnknown++instance Relabel Rhs where+  relabel iai env (Unguarded exp)  = Unguarded (relabel iai env exp)+  relabel iai env (Guarded gdexps) =+    Guarded (map (\(gd,exp)-> (relabel iai env gd, relabel iai env exp)) +      gdexps)++instance Relabel Type where+  relabel iai env (TypeCons p c typs) = +    TypeCons p (lookupTyCls env c) (map (relabel iai env) typs)+  relabel iai env (TypeApp t1 t2) = +    TypeApp (relabel iai env t1) (relabel iai env t2)+  relabel iai env (TypeVar p v)       = +    TypeVar p (mkTyVar iai v)+  relabel iai env (TypeStrict p t)    = +    TypeStrict p (relabel iai env t)++instance Relabel Sig where+  relabel iai env (Sig pis typ) = +    Sig (relabelPosIds iai pis) (relabel iai env typ)++instance Relabel Simple where+  relabel iai env (Simple p id pis) = +    Simple p (mkTyCon iai id) (relabelPosIds iai pis)++instance Relabel Context where+  relabel iai env (Context p id pis) = +    Context p (mkClass iai id) (relabelPosIds iai pis)++instance Relabel Constr where+  relabel iai env (Constr p id mbs) =+    Constr p (lookEnv env id) (map locust mbs)+    where +    locust (Nothing,typ) = (Nothing,relabel iai env typ)+    locust (Just pis,typ) = +      (Just (relabelRealPosIds env pis),relabel iai env typ)+  relabel iai env (ConstrCtx fvs ctxs p id mbs) =+    ConstrCtx (relabelPosIds iai fvs) (map (relabel iai env) ctxs) p+      (lookEnv env id) (map locust mbs)+      where +      locust (Nothing,typ) = (Nothing,relabel iai env typ)+      locust (Just pis,typ) = +        (Just (relabelRealPosIds env pis),relabel iai env typ)++instance Relabel Field where+  relabel iai env (FieldExp p id exp) = +    FieldExp p (mkField iai id) (relabel iai env exp)+  relabel iai env (FieldPun p id) = FieldPun p (mkField iai id)++instance Relabel Stmt where+  relabel iai env (StmtExp exp)      = StmtExp (relabel iai env exp)+  relabel iai env (StmtBind pat exp) = +    StmtBind (relabel iai env pat) (relabel iai env exp)+  relabel iai env (StmtLet decls)    = StmtLet (relabel iai env decls)++instance Relabel Qual where+  relabel iai env (QualPatExp pat exp) = +    QualPatExp (relabel iai env pat) (relabel iai env exp)+  relabel iai env (QualExp exp) = QualExp (relabel iai env exp)+  relabel iai env (QualLet decls) = QualLet (relabel iai env decls)++instance Relabel FunDep where+  relabel iai env (as :->: bs) =+        (map (mkTyVar iai) as) :->: (map (mkTyVar iai) bs)+++-- This is where the non-trivial syntax types start.  Local defns (let-bound)+-- and lhs patterns (lambda-bound) must be added to the environment before+-- relabeling the rhs of a function or binding.++instance Relabel Fun where+  relabel iai env (Fun pats rhs ds@(DeclsParse decls)) =+    let (irrefutableDeclIds,declEnv) = extendEnv undefined iai vi env decls+        (irrefutableIds,newEnv) = +          foldrPat (addPat iai Refutable vi) declEnv pats +    in+      Fun (map (relabel iai newEnv) pats) (relabel iai newEnv rhs) +        (addVars iai newEnv +          (nubBy (\x y -> show x == show y) -- for shadowing of scopes+            (irrefutableDeclIds++irrefutableIds)) +          (relabel iai newEnv ds))++instance Relabel Alt where+  -- only used for Alts in cases, not in pattern bindings+  relabel iai env (Alt pat rhs ds@(DeclsParse decls)) =+    let (irrefutableDeclIds,declEnv) = extendEnv undefined iai vi env decls+        (irrefutableIds,newEnv) = +          addPat iai Refutable vi pat declEnv+    in+      Alt (relabel iai newEnv pat) (relabel iai newEnv rhs) +        (addVars iai newEnv (nubBy (\x y -> show x == show y) -- for scope +          (irrefutableDeclIds++irrefutableIds)) +        (relabel iai newEnv ds))++instance Relabel Exp where+  relabel iai env (ExpScc str exp) = ExpScc str (relabel iai env exp)+  relabel iai env (ExpDict exp) = ExpDict (relabel iai env exp)+  relabel iai env (ExpFatbar e1 e2) = +    ExpFatbar (relabel iai env e1) (relabel iai env e2)+  relabel iai env (ExpFail) = ExpFail+  relabel iai env (ExpLambda p pats exp) =+	let (irrefutableIds,newEnv) = +              foldrPat (addPat iai Refutable vi) env pats in+	ExpLambda p (map (relabel iai newEnv) pats) +          ((if null irrefutableIds +             then id else ExpLet p (addVars iai newEnv irrefutableIds noDecls))+            (relabel iai newEnv exp))+  relabel iai env (ExpLet p ds@(DeclsParse decls) exp) =+	let (irrefutableIds,newEnv) = extendEnv undefined iai vi env decls in+	ExpLet p (addVars iai newEnv irrefutableIds (relabel iai newEnv ds)) +          (relabel iai newEnv exp)+  relabel iai env (ExpDo p stmts) =+	ExpDo p (doStmts env stmts)+    where doStmts env [] = []+	  doStmts env (s@(StmtExp _):ss) = relabel iai env s: doStmts env ss+	  doStmts env (s@(StmtBind pat _):ss) =+		let (irrefutableIds,newEnv) = addPat iai Refutable vi pat env +                in+		relabel iai newEnv s : +                (if null irrefutableIds +                   then id +                   else (StmtLet (addVars iai newEnv irrefutableIds noDecls):))+                  (doStmts newEnv ss)+	  doStmts env (s@(StmtLet (DeclsParse decls)):ss) =+		let (irrefutableIds,newEnv) = +                      extendEnv undefined iai vi env decls +                    StmtLet reDecls = relabel iai newEnv s+                in (StmtLet (addVars iai newEnv irrefutableIds reDecls) +                   : doStmts newEnv ss)+  relabel iai env (ExpCase p exp alts) =+    ExpCase p (relabel iai env exp) (map (relabel iai env) alts)+  relabel iai env (ExpIf p cond thn els) =+    ExpIf p (relabel iai env cond) (relabel iai env thn) (relabel iai env els)+  relabel iai env (ExpType p exp ctxs typ) =+    ExpType p (relabel iai env exp) (map (relabel iai env) ctxs) +      (relabel iai env typ)+  relabel iai env (ExpRecord exp fields) =+    ExpRecord (relabel iai env exp) (map (relabel iai env) fields)+  relabel iai env (ExpApplication p exps) =+    ExpApplication p (map (relabel iai env) exps)+  relabel _ env (ExpVar p id) = ExpVar p (lookEnv env id)+  relabel _ env (ExpCon p id)   = ExpCon p (lookEnv env id)+  relabel _ env (ExpVarOp p id) = ExpVarOp p (lookEnv env id)+  relabel _ env (ExpConOp p id) = ExpConOp p (lookEnv env id)+  relabel iai env (ExpInfixList p exps) = +    relabel iai env (fixInfixList env exps)+  relabel _ env (ExpLit p lit)   = ExpLit p lit+  relabel iai env (ExpList p exps) = ExpList p (map (relabel iai env) exps)+  relabel iai env (PatAs p id pat) =+    PatAs p (lookEnv env id) (relabel iai env pat)+  relabel _ env (PatWildcard p)  = PatWildcard p+  relabel iai env (PatIrrefutable p pat) = +    PatIrrefutable p (relabel iai env pat)+  relabel iai env (PatNplusK p id1 id2 exp1 exp2 exp3) = -- *** No, No, NO+    PatNplusK p (mkLambdaBound iai id1) (mkLambdaBound iai id2)+      (relabel iai env exp1) (relabel iai env exp2) (relabel iai env exp3)+++-- `relabelPosIds' does the simplest possible renaming of a list of+-- position/id pairs from the TokenId type to TraceId type.+relabelPosIds :: InitAuxInfo -> [(Pos,TokenId)] -> [(Pos,TraceId)]+relabelPosIds iai = map (\(p,i)->(p,mkLambdaBound iai i))++-- `relabelRealPosIds' does the correct (as opposed to simplest) renaming+-- of a list of position/id pairs from the TokenId type to TraceId type.+relabelRealPosIds :: Environment -> [(Pos,TokenId)] -> [(Pos,TraceId)]+relabelRealPosIds env = map (\(p,i)->(p,lookEnv env i))++-- Create definitions for let-bound variants of irrefutable variables.+addVars :: InitAuxInfo -> Environment -> [TokenId] -> Decls TraceId +        -> Decls TraceId+addVars iai env irrefutableIds (DeclsParse ds) =+  DeclsParse (map mkDef irrefutableIds ++ ds)+  where+  mkDef id = +    DeclFun noPos traceId+      [Fun [] +        (Unguarded (ExpVar noPos (modLambdaBound iai traceId))) noDecls]+    where  +    traceId = lookEnv env id
+ trans/AuxTypes.hs view
@@ -0,0 +1,175 @@+module AuxTypes where++import Data.Char (isDigit,isUpper)+import Data.List (isPrefixOf)+import Syntax+import AssocTree+import TokenId (TokenId(Qualified),tPrelude,visImport,t_Tuple)+import SysDeps (packString)++-- AuxiliaryInfo is the extra information we need to know about identifiers.+data AuxiliaryInfo = +         Value {- variable or constructor -}+	   { args     :: Int+	   , fixity   :: Fixity+	   , priority :: Int+	   , letBound :: Bool +           , traced   :: Bool}+       | TyCls TyCls -- needed for im/export of (..)+       deriving (Show,Read)+data Fixity = L | R | Pre String | Def | None deriving (Eq,Show,Read)+data TyCls = Ty [String]{- data constructors -} [String]{- field labels -}+           | Cls [String]{- methods -}+           | Syn Int {- no. helper type syns -} TySynBody+  deriving (Show,Read)+data TySynBody = +  TApp TySynBody TySynBody | TFun | THelper | TVar Int {- arg no. -}+  deriving (Show,Read)+++-- information needed for creating an AuixiliaryInfo+-- currently only flag if original identifier definition is traced+newtype InitAuxInfo = InitAuxInfo Bool++defaultAuxInfo :: InitAuxInfo+defaultAuxInfo = InitAuxInfo False++initAuxInfo :: Bool {-traced-} -> InitAuxInfo+initAuxInfo = InitAuxInfo++untracedEmptyAux :: AuxiliaryInfo+untracedEmptyAux =+  Value { args=(-1), fixity=Def, priority=9, letBound=True, traced=False}++emptyAux :: InitAuxInfo -> AuxiliaryInfo+emptyAux (InitAuxInfo tr) = +  Value { args=(-1), fixity=Def, priority=9, letBound=True, traced=tr}++patternAux :: InitAuxInfo -> AuxiliaryInfo+patternAux (InitAuxInfo tr) = +  Value { args=(-1), fixity=Def, priority=9, letBound=False, traced=tr}++-- Identifier is used to distinguish varids from conids, and relate+-- conids back to the type they belong to.  It also relates methods+-- to their class.+data Identifier = Var String | Con TypeSort String{-type-} String{-con-}+		| Field String{-type-} String{-field-}+		| Method String{-class-} String{-method-}+                | TypeClass String+	deriving (Show,Read,Eq,Ord)+data TypeSort = Data | Newtype deriving (Show,Read,Eq,Ord)++qual :: Identifier -> String -> Identifier+qual (Var v) m = Var (m++v)+qual (Con s t c) m = Con s t (m++c)+qual (Field t f) m = Field t (m++f)+qual (Method t f) m = Method t (m++f)+qual (TypeClass t) _ = TypeClass t++subTid :: Identifier -> TokenId+subTid (Var v)        = qualTid v+subTid (Con t _ c)    = possTuple c+subTid (Field t f)    = qualTid f+subTid (Method c m)   = qualTid m+subTid (TypeClass tc) = possTuple tc++qualTid i | isUpper (head i) && '.' `elem` i =+                  let (v,m) = break (=='.') (reverse i) in	-- approximation+                  Qualified (packString (tail m)) (packString v)+          | otherwise = visImport i++possTuple "()" = t_Tuple 0+possTuple s | "Prelude." `isPrefixOf` s =+    let nm = drop 8 s in+    if isDigit (head nm) then t_Tuple (read nm)+    else visImport s+possTuple s = visImport s++-- The main Environment is composed of two pieces...+type Environment = (AuxTree,IdentMap)++-- AuxTree is an environment, associating each identifier with a unique+-- AuxiliaryInfo.+type AuxTree = AssocTree Identifier AuxiliaryInfo++-- IdentMap is an environment associating each constructor/field with+-- its type, and each method with its class.  We can encounter a+-- constructor (or method) without its type (or class) in a fixity decl,+-- but we then need to know its type (or class) to know whether it+-- is exported or not.  If an entity is neither a known constructor/field+-- nor a known method, we assume it is just an ordinary variable.+-- Types and classes are not stored in an IdentMap+type IdentMap = AssocTree TokenId{-con, var, or method-} Identifier++-- `mkIdentMap' makes a little lookup table from data constructors and field+-- names to their type name, and methods to their class.  Additionally, it+-- builds a list of all defined types, plus synonyms and class names, used+-- to check that all exports have a referent.+mkIdentMap :: [Decl TokenId] -> (IdentMap,[TokenId])+mkIdentMap decls =+    let dataDecls  = concatMap dataDecl decls+        classDecls = concatMap classDecl decls+    in ( foldr addMethod (foldr addCon initAT dataDecls) classDecls+       , map (\(x,_,_)->x) dataDecls ++ map fst classDecls +         ++ concatMap typeSyn decls)+  where+    dataDecl (DeclData Nothing _ (Simple _ typ _) tycons _)  = +      [(typ,Newtype,tycons)]+    dataDecl (DeclData (Just _) _ (Simple _ typ _) tycons _)  = +      [(typ,Data,tycons)]+    dataDecl _ = []++    classDecl (DeclClass _ _ cls _ _ (DeclsParse decls)) = [(cls,decls)]+    classDecl _ = []++    typeSyn (DeclType (Simple pos id vars) _) = [id]+    typeSyn _ = []++    addCon :: (TokenId,TypeSort,[Constr TokenId]) -> IdentMap -> IdentMap+    addCon (typ,typeSort,tycons) t = foldr doCon t tycons+	where+        doCon (Constr _ c fs) t        = conAndFields c fs t+        doCon (ConstrCtx _ _ _ c fs) t = conAndFields c fs t+        conAndFields c fs t = addFields (addAT t const c+                                          (Con typeSort styp (show c)))+                                          styp fs+        styp = show typ++    addFields :: IdentMap -> String -> [(Maybe [(t, TokenId)],b)] -> IdentMap+    addFields t typ [] = t+    addFields t typ ((Nothing,_):_) = t+    addFields t typ ((Just posids,_):cs) = foldr doField (rest t) posids+        where+            doField (_,f) t = addAT t const f (Field typ (show f))+            rest t = addFields t typ cs++    addMethod :: (TokenId,[Decl TokenId]) -> IdentMap -> IdentMap+    addMethod (cls, decls) t = foldr doMethod t decls+	where+	    doMethod (DeclVarsType pis ctxs typ) t = foldr pId t pis+	    doMethod _ t = t+	    pId (pos,meth) t = addAT t const meth+                                     (Method (show cls) (show meth))++useIdentMap :: IdentMap -> TokenId -> Identifier+useIdentMap m v =+      case lookupAT m v of+	Just tc -> tc+	Nothing -> Var (show v)++-- The following hack is needed, because identMap only knows about global+-- identifiers and because variables, field labels and methods share the+-- same name space.+useEnvironment :: Environment -> TokenId -> Maybe AuxiliaryInfo+useEnvironment (env,identMap) id =+  let v = useIdentMap identMap id in+  case v of+    -- a field or method may be shadowed by a normal variable+    -- hence have to search for such a variable first+    Field _ name -> case lookupAT env (Var name) of+                      Just info -> Just info+                      Nothing -> lookupAT env v+    Method _ name -> case lookupAT env (Var name) of+                       Just info -> Just info+                       Nothing -> lookupAT env v+    _ -> lookupAT env v
+ trans/Flags.hs view
@@ -0,0 +1,194 @@+{- ---------------------------------------------------------------------------+Flags are all the choices and information given to the compiler in the +argument list. Here a data type Flags is defined for holding this information,+a function processArgs to obtain a value of type Flags from the argument list,+and a simple function pF for printing information demanded by a flag.+-}+module Flags+  (Flags,processArgs,pF+  ,sUnix+  ,sUnlit+  ,sSourceFile+  ,sUnderscore+  ,sLex+  ,sParse+  ,sTraceFns+  ,sPrelude+  ,sPreludes+  ,sIncludes+  ,sDbgTrusted+  ,sWrap+  ,sRealFile+  ,sIBound+  ,sShowWidth+  ,sShowIndent+  ,sShowQualified+  ,sHatAuxFile+  ,sHatTransFile+  ,sHatFileBase+  ,sSrcDir+  ) where++import System.IO+import OsOnly(fixRootDir,fixTypeFile,fixObjectFile+             ,fixHatAuxFile,fixHatTransFile,fixHatTransDir,fixHatFileBase)+import Data.List(isPrefixOf,isSuffixOf)+import Data.Char(isDigit)+++data Flags = FF +  {sRealFile   :: String+  ,sSourceFile :: String+  ,sHatAuxFile   :: String+  ,sHatTransFile :: String+  ,sHatFileBase  :: String+  ,sIncludes   :: [String]+  ,sPreludes   :: [String]+  ,sSrcDir     :: String++--v Flags to control compilation+  ,sUnix       :: Bool	-- either unix or RiscOS+  ,sUnlit      :: Bool	-- unliterate the source code+  ,sPrelude    :: Bool	-- keep prelude defns in interface file++--v Flags to control compilation for tracing+  ,sDbgTrusted :: Bool	-- trust this module+  ,sWrap       :: Bool	-- wrap original defns rather than transforming++--v Flags for machine architecture / configuration+  ,sUnderscore :: Bool	-- force H'98 underscores++--v debugging flags - show program / import tables (after each compiler phase)+  ,sLex        :: Bool	-- input	after lexing+  ,sParse      :: Bool	-- ast		after parsing+  ,sTraceFns   :: Bool	-- ast		after tracing transform (fns)+  ,sIBound     :: Bool	-- aux tree     after ast annotation++--v pretty-printing flags+  ,sShowWidth  :: Int   -- width for showing intermediate program+  ,sShowIndent :: Int   -- indentation for nesting shown intermediate program+  ,sShowQualified :: Bool -- show qualified ids as far as possible+  }+  deriving Show++++{- If first argument is True, then print second and third with formatting -}+pF :: Bool -> [Char] -> [Char] -> IO ()+pF flag title text =+  if flag +    then hPutStr stderr ( "======\t"++title++":\n"++text++"\n") +    else return ()++{- ---------------------------------------------------------------------------+All the following functions obtain information from the argument list of the+compiler to set flags appropriately.+-}++{-+The main function for processing the argument list.+Aborts with error, if the required filenames are not in argument list.+(But no further error checking)+-}++processArgs :: [String] -> Flags++processArgs xs = flags+ where+ (rootdir,filename) = fixRootDir isUnix sourcefile+ isUnix = sUnix flags++ (realfile,sourcefile) =+   case getFiles xs of+     [sourcefile] -> (sourcefile,sourcefile)+     [realfile,sourcefile] -> (realfile,sourcefile)+     _ -> error ("\nUsage: hat-trans file.[l]hs\n\ +\       hat-trans tmpfile.[l]hs origfile.[l]hs\n")  ++ flags = FF+  { sRealFile   = realfile	-- filename to open+  , sSourceFile = sourcefile	-- original name before any preprocessor+  , sHatAuxFile = fixHatAuxFile isUnix rootdir filename+  , sHatTransFile = fixHatTransFile isUnix rootdir filename+  , sHatFileBase  = fixHatFileBase isUnix rootdir filename+  , sIncludes = getIncludes xs++[rootdir]+  , sPreludes = getPreludes xs+  , sSrcDir   = fixHatTransDir isUnix rootdir++  , sUnix = fElem True  "unix" xs          	+  -- ^ Use unix file names+  , sUnlit = fElem (".lhs" `isSuffixOf` realfile) "unlit" xs         	+  -- ^ Unliterate the source code+  , sPrelude = fElem False "prelude" xs		+  -- Keep prelude definitions in interface file++  , sDbgTrusted = fElem False "trusted" xs    -- "trusted" module (don't trace)+  , sWrap       = fElem False "wrap" xs       -- "wrapped" module (don't trace)++  , sUnderscore = fElem True "underscore" xs +  -- ^ Enable H'98 underscore-is-lower-case++  , sLex = fElem False "lex" xs         -- show lexical input+  , sParse  = fElem False "parse" xs    -- show syntax tree  after  parser+  , sTraceFns = fElem False "tracefns" xs  -- ast after transforming functions+  , sIBound = fElem False "ibound" xs   -- aux tree after ast annotation++  , sShowWidth = cardFlag 80 "showwidth=" xs  -- set width for showing +                                              -- intermediate program+  , sShowIndent = cardFlag 2 "showindent=" xs -- set indentation for nesting+  , sShowQualified = fElem True "showqualified" xs  +  -- ^ show qualified ids as far as possible+  }+  +  +{- obtain list of filenames from argument list -}+getFiles :: [String] -> [String]+getFiles = filter (\xs -> case xs of ('-':_) -> False ; _ -> True)+++{- obtain list of include paths from argument list -}+getIncludes :: [String] -> [String]+getIncludes = map (drop (2::Int)) . +              filter (\xs -> case xs of ('-':'I':_) -> True  +                                        ('-':'i':_) -> True  +                                        _           -> False)++{- obtain list of prelude paths from argument list -}+getPreludes :: [String] -> [String]+getPreludes = map (drop (2::Int)) . +              filter (\xs -> case xs of ('-':'P':_) -> True ; _ -> False)+++{-+Returns if given option is set or not in argument list.+If it is neither set nor unset, then default value (first arg.) is returned.+-}+fElem :: Bool -> [Char] -> [String] -> Bool+fElem def f flags = if ('-':f) `elem` flags then True+                    else if ('-':'n':'o':f) `elem` flags then False+                    else def+++{-+Returns the value of an option with a numerical (cardinal) value.+If the option is not given, then the default value (first arg.) is returned.+Ignores syntactically incorrect options.+-}+cardFlag :: Int -> [Char] -> [String] -> Int+cardFlag def f flags = if null settings then def else read (last settings)+  where+  settings = filter (all isDigit) . map (drop (length f + 1)) . +             filter (isPrefixOf ('-':f)) $ flags++++{-+Returns the value of a "-something=" option with a string value.+If the option is not given, then the default value (first arg.) is returned.+-}+stringFlag :: String -> String -> [String] -> String+stringFlag def f flags = if null settings then def else last settings+  where+  settings = map (drop (length f + 1)) . +             filter (isPrefixOf ('-':f)) $ flags+
+ trans/HatTrans.hs view
@@ -0,0 +1,183 @@+{- ---------------------------------------------------------------------------+This `main' function is basically just the front-end of the nhc98+compiler.  It parses the .hs source file, creates the .hx file, and+then stops immediately after writing a new transformed .hs file.+-} +module Main where+++import System.IO+import System.Environment(getArgs)+import System.Exit(exitWith,ExitCode(..))+import System.IO.Error(isAlreadyExistsError)+import Control.Monad(when)+import Data.List(isPrefixOf,intersperse,inits)+import System.Directory(doesDirectoryExist,createDirectory)++import Error+import Syntax+import Extra (Pos(..),mix,mixSpace,jRight,jLeft,noPos,strPos,showErr,mixLine+             ,pair,fst3,thd3,trace)+import AssocTree(listAT) -- for debugging output+import ParseCore (Parser(..),ParseBad(..),ParseError(..),ParseGood(..)+                 ,ParseResult(..),parseit)+import Flags (Flags(..),processArgs,pF,sUnderscore,sRealFile,sSourceFile,sUnlit+             ,sLex,sParse,sPrelude,sSrcDir,sIBound,sWrap+             ,sHatFileBase,sHatAuxFile,sTraceFns,sHatTransFile,sDbgTrusted)+import PrettyTraceId (prettyPrintTokenId,prettyPrintId,prettyPrintTraceId+                     ,ppModule,ppTopDecls,ppClassCodes)++import TokenId (TokenId(..),getUnqualified+               ,visible,t_Arrow,t_List,tPrelude,tminus,tnegate,tTrue)+import IdKind (IdKind(..))+import Id (Id)+import Lex (Lex,LexAnnot)  -- need show++import Unlit (unlit)+import Lexical (PosToken(..),PosTokenPre(..),LexState(..),lexical)+import Parse (parseProg)++import AuxFile (toAuxFile)+import AuxLabelAST (auxLabelSyntaxTree)+import TraceTrans (traceTrans,maybeStripOffQual)+import Wrapper (prepareWrapping)++import Paths_hat (getDataDir)+++--import NonStdProfile+--beginPhase str = profile str (return ())+beginPhase str = return ()++-- some miscellaneous settings+primFlags = (False   -- bool is not the same as Word+	    ,False   -- && || not is not primitive+	    ,False   -- translate into prim only when strict+	    )++-- some nicer error handling+catchError :: Either b a -> String -> (b->String) -> IO a+catchError comp errmsg showErrors = do+    case comp of+        Left errs -> do pF True errmsg (showErrors errs)+                        exit+        Right a   -> return a++-- for Hugs, which cannot read commandline args using System.getArgs:+gmain cml = main' (words cml)++-- for all other compilers:+main = do+  args <- getArgs+  main' args++main' args = do+  let flagsArgs = processArgs args+  preludePath <- getDataDir+  let flags = flagsArgs{sPreludes = preludePath : (sPreludes flagsArgs)}+  let filename = sRealFile flags+++  {- lex source code -}+  beginPhase "lex"+  mainChar	-- :: String+           <- catch (readFile filename) (can'tOpen filename) +  lexdata	-- :: [PosToken]+           <- return (lexical (sUnderscore flags) (sSourceFile flags)+                              (if sUnlit flags +                                then unlit (sSourceFile flags) mainChar +                                else mainChar))+  pF (sLex flags) "Lexical" +       (mixSpace (map (\ (p,l,_,_) -> strPos p ++ ':':show l) lexdata))+++  {- parse source code -}+  beginPhase "parse"+  parsedPrg	-- :: Module TokenId+            <- catchError (parseit parseProg lexdata)+                          ("In file: "++sSourceFile flags) showErr+  pF (sParse flags) "Parse" (prettyPrintTokenId flags ppModule parsedPrg) ++  {- Ensure we can write our output files. -}+  let hatDir = sSrcDir flags+  dir <- doesDirectoryExist hatDir+  when (not dir) (createDirectoriesRecursively hatDir)++  {- If wrapping rather than transforming, then prepare the parsed AST.+  -}+  parsedPrg <- if sWrap flags then return (prepareWrapping (sSourceFile flags) parsedPrg)+                              else return parsedPrg+  when (sWrap flags)+       (pF (sParse flags) "Wrap" (prettyPrintTokenId flags ppModule parsedPrg))++  {-+  -- Read and write auxiliary information files (for tracing).+  -- Then relabel the syntax tree with the auxiliary information.+  -- Then the tracing transformation itself is applied.+  -- The result is written to file (no redirection possible yet)+  -}+  let prg = implicitlyImportPrelude flags +              (maybeStripOffQual "Prelude" parsedPrg)+  pF (sParse flags) "post-Prelude" (prettyPrintTokenId flags ppModule parsedPrg)+  -- hack to make full environment available when writing aux file+  -- (needed for handling partial expansion of type synonyms)+  (env,newprog) <- auxLabelSyntaxTree flags prg+  toAuxFile env flags (sHatAuxFile flags) prg -- waste space: hold on to prg++  when (sIBound flags)+    (print (listAT (fst env)))++  when (sTraceFns flags)+       (putStr (prettyPrintTraceId flags ppModule newprog)) -- debug+  let outputTree = (implicitlyImportPreludeBasic flags +                     (maybeStripOffQual "Hat.Prelude"+                       (traceTrans (not (sDbgTrusted flags)) (sSourceFile flags) +                         (sHatFileBase flags) newprog)))+  writeFile (sHatTransFile flags)+      (prettyPrintTokenId flags ppModule outputTree)+  putStrLn ("Wrote " ++ sHatTransFile flags)+  exitWith (ExitSuccess)+++-- add implicit Prelude, if it is not imported explicitly and we +-- are not currently transforming part of the Prelude.+implicitlyImportPrelude :: Flags -> Module TokenId -> Module TokenId+implicitlyImportPrelude flags+  (Module pos modId exports imports fixities decls) =+  Module pos modId exports imports' fixities decls+  where +  imports' = +    if (sPrelude flags && "Prelude" `isPrefixOf` getUnqualified modId) ||+       (any ((==) tPrelude . importedModule) imports)+      then imports +      else Import (noPos,tPrelude) (Hiding []) : imports++-- import implementation of Prelude qualified+-- use this for transformation-introduced Prelude identifiers+-- even some internal identifiers that are not part of the Prelude+-- (e.g. for deriving of instances)+implicitlyImportPreludeBasic :: Flags -> Module TokenId -> Module TokenId+implicitlyImportPreludeBasic flags+  (Module pos modId exports imports fixities decls) =+  Module pos modId exports imports' fixities decls+  where +  imports' = +    if sPrelude flags && "Hat.Prelude" `isPrefixOf` getUnqualified modId+      then imports +      else+        ImportQ (noPos,visible (reverse "Hat.PreludeBasic")) (Hiding []) +        : imports+++createDirectoriesRecursively path = do+    putStrLn ("Creating directories "++unwords paths)+    mapM_ safeCreate paths+  where paths = accum (wordsBy '/' path)+        accum xs = map (concat . intersperse "/") (tail (inits xs))+        wordsBy c s = let (w,s') = break (==c) s+                      in w: case s' of [] -> []; (_:s'') -> wordsBy c s''+        safeCreate path = catch (createDirectory path)+                                (\e-> if isAlreadyExistsError e then return ()+                                      else ioError e)++{- End Module Main ----------------------------------------------------------}
+ trans/PrettyTraceId.hs view
@@ -0,0 +1,45 @@+{-+Convert abstract syntax tree (or parts of it) into +a structured document for pretty printing.+-}++module PrettyTraceId+  ( module PrettySyntax+  , prettyPrintTraceId+  ) where ++import PrettyLib+import PrettySyntax+import Flags (Flags,sShowWidth,sShowQualified,sShowIndent)+import TraceId (TraceId,hasValueInfo,arity,isLambdaBound,tokenId)+import AuxTypes (AuxiliaryInfo) -- hbc's broken import mechanism needs this+import TokenId (TokenId(..),extractV,t_Arrow,t_List)+import Id (Id)+import SysDeps (unpackPS)+++prettyPrintTraceId :: Flags -> (PPInfo TraceId -> a -> Doc) -> a -> String++prettyPrintTraceId flags pp =+  pretty (sShowWidth flags) . +  pp PPInfo{withPositions = False+           ,indent = sShowIndent flags+           ,id2str = id2strTraceId+           ,tyVar2str = id2strTraceId -- show+           ,isFunctionArrow = (\tr-> tokenId tr == t_Arrow)+           ,isList = (\tr-> tokenId tr == t_List)+           ,maybeTuple = maybeTupleTraceId}+  where+  id2strTraceId t = ( if sShowQualified flags+                      then show (tokenId t)+                      else (reverse . unpackPS . extractV) (tokenId t)+                    ) +++                    ( if hasValueInfo t +                        then "{-"++ show (arity t) ++"/"+++                             ( if isLambdaBound t then "lam-}" else "let-}" )+                        else "")+  maybeTupleTraceId t = case tokenId t of+                          TupleId n -> Just n+                          _         -> Nothing++
+ trans/TraceDerive.hs view
@@ -0,0 +1,522 @@+module TraceDerive where++import Syntax+import TraceId +  (TraceId,mkLambdaBound,tokenId,getUnqualified,dropModule,modArity+  ,tPriority,tFixity,Fixity(..)+  ,tTokenTrue,tTokenFalse,tTokenEqualEqual,tTokenAndAnd+  ,tTokenEQ,tTokenCompare,tTokenLocalFromEnum,tTokenInt+  ,tTokenMinBound,tTokenMaxBound,tTokenFromEnum,tTokenToEnum+  ,tTokenError,tTokenEnumFrom,tTokenEnumFromThen,tTokenEnumFromTo+  ,tTokenEnumFromThenTo,tTokenGreater,tTokenGreaterEqual,tTokenCompose+  ,tTokenShowsPrec,tTokenShowParen,tTokenShowString,tTokenShowChar+  ,tTokenReadsPrec,tTokenReadParen,tTokenYield,tTokenAlt,tTokenThenAp+  ,tTokenThenLex,tTokenRange,tTokenIndex,tTokenInRange,tTokenMap,tTokenMinus+  ,tTokenLocalToEnum,tTokenTuple2,tTokenFun,tTokenRangeSize+  ,tTokenGtGtEq,tTokenPlus,tTokenTimes,tTokenReturn)+import TokenId (mkUnqualifiedTokenId,tEq)+import AuxTypes (defaultAuxInfo)++-- ----------------------------------------------------------------------------++-- derive instances for all given classes for a data/newtype+derive :: [Context TraceId] -> Simple TraceId -> [Constr TraceId] +       -> [(Pos,TraceId)] -> [Decl TraceId]+derive tyContexts sTy constrs = +  map (deriveClass tyContexts (simpleToType sTy) pTyVars constrs)+  where+  Simple _ _ pTyVars = sTy++-- derive instance for a given class for a data/newtype+deriveClass :: [Context TraceId] -> Instance TraceId -> [(Pos,TraceId)] +            -> [Constr TraceId] -> (Pos,TraceId) -> Decl TraceId+deriveClass tyContexts instTy pTyVars constrs (pos,cls) +  | getUnqualified cls == "Eq" = deriveEq pos usualContexts cls instTy constrs+  | getUnqualified cls == "Ord" = +    deriveOrd pos usualContexts cls instTy constrs+  | getUnqualified cls == "Bounded" =+    deriveBounded pos usualContexts cls instTy constrs+  | getUnqualified cls == "Enum" = +    deriveEnum pos usualContexts cls instTy constrs+  | getUnqualified cls == "Read" = +    deriveRead pos usualContexts cls instTy constrs+  | getUnqualified cls == "Show" = +    deriveShow pos usualContexts cls instTy constrs+  | getUnqualified cls == "Ix" = +    deriveIx pos usualContexts cls instTy constrs+  | otherwise = error ("deriveClass: unknown class " ++ show (tokenId cls))+  where+  -- this is a HACK that covers only the common cases+  -- for correct result would need to implement full context reduction+  -- and take the least fixpoint+  usualContexts = tyContexts ++ map (\pt-> Context pos cls [pt]) pTyVars++-- ----------------------------------------------------------------------------++deriveEq :: Pos +         -> [Context TraceId] -> TraceId -> Instance TraceId +         -> [Constr TraceId] +         -> Decl TraceId+deriveEq pos contexts cls ty constrs =+  DeclInstance pos contexts cls [ty]+    (DeclsParse +      [DeclFun pos (modArity (dropModule tTokenEqualEqual) 2)+        (map funEqConstr constrs ++ +          [Fun [PatWildcard pos,PatWildcard pos] +            (Unguarded (ExpCon pos tTokenFalse)) noDecls])])+  where+  vars = traceVars pos+  funEqConstr :: Constr TraceId -> Fun TraceId+  funEqConstr constr = +    if arity == 0 +      then+        Fun [ExpCon pos conId,ExpCon pos conId] +          (Unguarded (ExpCon pos tTokenTrue)) noDecls+      else+        Fun +          [ExpApplication pos (ExpCon pos conId : argsL)+          , ExpApplication pos  (ExpCon pos conId : argsR)]+          (Unguarded (foldr1 andExp (zipWith equalExp argsL argsR)))+          noDecls+    where+    andExp :: Exp TraceId -> Exp TraceId -> Exp TraceId+    andExp e1 e2 = ExpApplication pos [ExpVar pos tTokenAndAnd,e1,e2]+    equalExp :: Exp TraceId -> Exp TraceId -> Exp TraceId+    equalExp e1 e2 = ExpApplication pos [ExpVar pos tTokenEqualEqual,e1,e2]+    (argsL,restVars) = splitAt arity vars+    argsR = take arity restVars+    conId = getConstrId constr+    arity = constrArity constr++-- ----------------------------------------------------------------------------++deriveOrd :: Pos +          -> [Context TraceId] -> TraceId -> Instance TraceId +          -> [Constr TraceId] +          -> Decl TraceId+deriveOrd pos contexts cls ty constrs =+  DeclInstance pos contexts cls [ty]+    (DeclsParse +      [DeclFun pos (modArity (dropModule tTokenCompare) 2)+        (concatMap funCompareEqConstr constrs ++ +          [Fun [var1,var2] +            (Unguarded +              (ExpApplication pos +                [ExpVar pos tTokenCompare+                ,ExpType pos (ExpApplication pos [localFromEnumVar,var1])+                   [] (TypeCons pos tTokenInt [])+                ,ExpApplication pos [localFromEnumVar,var2]]))+            (DeclsParse +              [DeclFun pos tTokenLocalFromEnum+                (zipWith funLocalFromEnum constrs [0..])])])])+  where+  var1:var2:vars = traceVars pos+  localFromEnumVar = ExpVar pos tTokenLocalFromEnum+  funCompareEqConstr constr = +    if arity == 0 then []+      else+        [Fun+          [ExpApplication pos (ExpCon pos conId : argsL)+          ,ExpApplication pos (ExpCon pos conId : argsR)]+          (Unguarded (foldr1 caseExp (zipWith compareExp argsL argsR)))+          noDecls]+    where+    caseExp :: Exp TraceId -> Exp TraceId -> Exp TraceId+    caseExp e1 e2 = +      ExpCase pos e1 +        [Alt (ExpCon pos tTokenEQ) (Unguarded e2) noDecls+        ,Alt var1 (Unguarded var1) noDecls]+    compareExp :: Exp TraceId -> Exp TraceId -> Exp TraceId+    compareExp e1 e2 = ExpApplication pos [ExpVar pos tTokenCompare,e1,e2]+    (argsL,restVars) = splitAt arity vars+    argsR = take arity restVars+    conId = getConstrId constr+    arity = constrArity constr+  funLocalFromEnum constr num =+    Fun [ExpApplication pos (ExpCon pos conId : args)]+      (Unguarded (ExpLit pos (LitInteger Boxed num)))+      noDecls+    where+    args = replicate (constrArity constr) (PatWildcard pos)+    conId = getConstrId constr+++-- ----------------------------------------------------------------------------++deriveBounded :: Pos +              -> [Context TraceId] -> TraceId -> Instance TraceId +              -> [Constr TraceId] +              -> Decl TraceId+deriveBounded pos contexts cls ty constrs =+  DeclInstance pos contexts cls [ty]+    (if all (== 0) (map constrArity constrs) +      then+        (DeclsParse+          [DeclFun pos (modArity (dropModule tTokenMinBound) 0)+            [Fun [] (Unguarded (ExpCon pos (getConstrId (head constrs)))) +              noDecls]+          ,DeclFun pos (modArity (dropModule tTokenMaxBound) 0)+            [Fun [] (Unguarded (ExpCon pos (getConstrId (last constrs)))) +              noDecls]])+      else {- exactly one constructor -}+        let [constr] = constrs in+          (DeclsParse+            [DeclFun pos (modArity (dropModule tTokenMinBound) 0)+              [Fun [] (Unguarded +                  (ExpApplication pos +                    (ExpCon pos (getConstrId (head constrs)) +                    : replicate (constrArity constr) +                        (ExpVar pos tTokenMinBound)) )) +              noDecls]+            ,DeclFun pos (modArity (dropModule tTokenMaxBound) 0)+              [Fun [] (Unguarded +                  (ExpApplication pos +                    (ExpCon pos (getConstrId (head constrs)) +                    : replicate (constrArity constr) +                        (ExpVar pos tTokenMaxBound)) )) +              noDecls]]))++-- ----------------------------------------------------------------------------++deriveEnum :: Pos +           -> [Context TraceId] -> TraceId -> Instance TraceId +           -> [Constr TraceId] +           -> Decl TraceId+deriveEnum pos contexts cls ty constrs =+  -- assert: all (== 0) (map constrArity constrs) +  DeclInstance pos contexts cls [ty]+    (DeclsParse+      [DeclFun pos (modArity (dropModule tTokenFromEnum) 1)+        (zipWith funFromEnum constrs [0..])+      ,DeclFun pos (modArity (dropModule tTokenToEnum) 1)+        (zipWith funToEnum constrs [0..] ++ +          [Fun [PatWildcard pos] (Unguarded +            (ExpApplication pos +              [ExpVar pos tTokenError+              ,ExpLit pos (LitString Boxed "toEnum: argument out of bounds")]))+            noDecls])+      ,DeclFun pos (modArity (dropModule tTokenEnumFrom) 1)+        [Fun [var1] (Unguarded +          (ExpApplication pos+            [ExpVar pos tTokenEnumFromTo,var1+            ,ExpCon pos (getConstrId (last constrs))]))+          noDecls]+      ,DeclFun pos (modArity (dropModule tTokenEnumFromThen) 2)+        [Fun [var1,var2] (Unguarded+          (ExpApplication pos+            [ExpVar pos tTokenEnumFromThenTo,var1,var2+            ,ExpIf pos+              (ExpApplication pos +                [ExpVar pos tTokenGreaterEqual+                ,ExpApplication pos [ExpVar pos tTokenFromEnum,var1]+                ,ExpApplication pos [ExpVar pos tTokenFromEnum,var2]])+              (ExpCon pos (getConstrId (last constrs)))+              (ExpCon pos (getConstrId (head constrs)))]))+          noDecls]+      ])+  where+  var1:var2:_ = traceVars pos+  funFromEnum constr num =+    Fun [ExpCon pos (getConstrId constr)] +      (Unguarded (ExpLit pos (LitInteger Boxed num)))+      noDecls+  funToEnum constr num =+    Fun [ExpLit pos (LitInteger Boxed num)] +      (Unguarded (ExpCon pos (getConstrId constr)))+      noDecls++-- ----------------------------------------------------------------------------++deriveShow :: Pos +           -> [Context TraceId] -> TraceId -> Instance TraceId +           -> [Constr TraceId] +           -> Decl TraceId+deriveShow pos contexts cls ty constrs =+  DeclInstance pos contexts cls [ty]+    (DeclsParse+      [DeclFun pos (modArity (dropModule tTokenShowsPrec) 2)+        (map funShowsPrec constrs)])+  where+  precVar:vars = traceVars pos+  funShowsPrec constr =+    Fun [precVar,ExpApplication pos (ExpCon pos conId:args)] (Unguarded+      (if arity == 0 +         then showStringExp (getUnqualified conId)+         else+           case getUnqualified conId of+             ':':_ -> -- is defined in infix style (and arity == 2)+               ExpApplication pos +                 [ExpVar pos tTokenShowParen+                 ,ExpApplication pos +                   [ExpVar pos tTokenGreater,precVar+                   ,ExpLit pos +                     (LitInteger Boxed priority)]+                 ,  showPrec priorityPlus1 (head args) +                  `compose`+                    showStringExp (' ' : getUnqualified conId ++ " ")+                  `compose`+                    showPrec priorityPlus1 (args!!1)+                 ]+             _ ->+               let labels = map snd . getConstrLabels $ constr in+               if null labels +                 then+                   ExpApplication pos +                     [ExpVar pos tTokenShowParen+                     ,ExpApplication pos +                       [ExpVar pos tTokenGreater,precVar+                       ,ExpLit pos (LitInteger Boxed priority)]+                     ,showStringExp (getUnqualified conId ++ " ")+                        `compose`+                       foldr1 composeSpace (map (showPrec priorityPlus1) args)+                     ]+                 else+                   showStringExp (getUnqualified conId ++ "{")+                     `compose`+                     foldr1 composeComma (zipWith showField labels args)+                     `compose`+                     showCharExp '}'+      ))+      noDecls+    where+    showStringExp s = +      ExpApplication pos +        [ExpVar pos tTokenShowString+        ,ExpLit pos (LitString Boxed s)]+    showCharExp c = +      ExpApplication pos +        [ExpVar pos tTokenShowChar+        ,ExpLit pos (LitChar Boxed c)]+    e1 `compose` e2 = ExpApplication pos [ExpVar pos tTokenCompose,e1,e2]+    e1 `composeSpace` e2 = e1 `compose` showCharExp ' ' `compose` e2+    e1 `composeComma` e2 = e1 `compose` showCharExp ',' `compose` e2+    showField label e = +      showStringExp (getUnqualified label) `compose` showCharExp '=' +        `compose` showPrec 0 e +    showPrec d e = +      ExpApplication pos +        [ExpVar pos tTokenShowsPrec,ExpLit pos (LitInteger Boxed d),e]+    args = take arity vars+    conId = getConstrId constr+    arity = constrArity constr+    priority = toInteger (tPriority conId)+    priorityPlus1 = priority+1 ++      +-- ----------------------------------------------------------------------------++deriveRead :: Pos +           -> [Context TraceId] -> TraceId -> Instance TraceId +           -> [Constr TraceId] +           -> Decl TraceId+deriveRead pos contexts cls ty constrs =+  DeclInstance pos contexts cls [ty]+    (DeclsParse+      [DeclFun pos (modArity (dropModule tTokenReadsPrec) 1)+        [Fun [precVar] (Unguarded (foldr1 alt . map expReadsPrec $ constrs)) +          noDecls]])+  where+  precVar:_ = traceVars pos+  e1 `alt` e2 = ExpApplication pos [ExpVar pos tTokenAlt,e1,e2]+  expReadsPrec constr =+    if arity == 0 +      then readParen (ExpCon pos tTokenFalse) +             (yield (ExpCon pos conId) `thenLex` getUnqualified conId)+      else+        case getUnqualified conId of+          ':':_ -> -- is defined in infix style (and arity == 2)+            readParen precGreaterPriority+              (yield (ExpCon pos conId) `thenAp`+                readsArg `thenLex` getUnqualified conId `thenAp` readsArg)+          _ ->+           let labels = map snd . getConstrLabels $ constr in+           if null labels +             then+               readParen precGreaterPriority+                 (foldl thenAp +                    (yield (ExpCon pos conId) `thenLex` getUnqualified conId)+                    (replicate arity readsArg))+             else+               (foldl thenCommaField+                 (yield (ExpCon pos conId) `thenLex` getUnqualified conId +                   `thenLex` "{" `thenField` (head labels))+                 (tail labels))+                 `thenLex` "}" +    where+    infixl 6 `thenAp`,`thenLex`, `thenField`+    readParen c e = ExpApplication pos [ExpVar pos tTokenReadParen,c,e]+    yield e = ExpApplication pos [ExpVar pos tTokenYield,e]+    e1 `thenLex` s = ExpApplication pos [ExpVar pos tTokenThenLex,e1,string s]+    e1 `thenAp` e2 = ExpApplication pos [ExpVar pos tTokenThenAp,e1,e2]+    precGreaterPriority = +      ExpApplication pos +        [ExpVar pos tTokenGreater,precVar+        ,ExpLit pos (LitInteger Boxed priority)]+    string s = ExpLit pos (LitString Boxed s)+    readsArg = +      ExpApplication pos +        [ExpVar pos tTokenReadsPrec+        ,ExpLit pos (LitInteger Boxed priorityPlus1)]+    readsArg0 = +      ExpApplication pos +        [ExpVar pos tTokenReadsPrec+        ,ExpLit pos (LitInteger Boxed 0)]+    p `thenField` label = +      p `thenLex` getUnqualified label `thenLex` "=" +        `thenAp` readsArg0 +    p `thenCommaField` label = p `thenLex` "," `thenField` label+    conId = getConstrId constr+    arity = constrArity constr+    priority = toInteger (tPriority conId)+    priorityPlus1 = priority+1 ++-- ----------------------------------------------------------------------------++deriveIx :: Pos +         -> [Context TraceId] -> TraceId -> Instance TraceId +         -> [Constr TraceId] +         -> Decl TraceId+deriveIx pos contexts cls ty constrs =+  DeclInstance pos contexts cls [ty]+    (if all (== 0) (map constrArity constrs) +      then+        (DeclsParse+          [DeclFun pos (modArity (dropModule tTokenRange) 1)+            [Fun [ExpApplication pos [ExpCon pos tTokenTuple2,lvar,uvar]] +              (Unguarded +                (ExpApplication pos +                  [ExpVar pos tTokenMap,toEnumVar+                  ,ExpApplication pos +                    [ExpVar pos tTokenEnumFromTo+                    ,ExpApplication pos [fromEnumVar,lvar]+                    ,ExpApplication pos [fromEnumVar,uvar]]]))+              (DeclsParse (declsToEnum ++ declsFromEnum))]+          ,DeclFun pos (modArity (dropModule tTokenIndex) 2)+            [Fun [ExpApplication pos [ExpCon pos tTokenTuple2,lvar,uvar],ivar] +              (Unguarded +                (ExpApplication pos +                  [ExpVar pos tTokenMinus+                  ,ExpApplication pos [fromEnumVar,ivar]+                  ,ExpApplication pos [fromEnumVar,lvar]]))+              (DeclsParse declsFromEnum)]+          ,DeclFun pos (modArity (dropModule tTokenInRange) 2)+            [Fun [ExpApplication pos [ExpCon pos tTokenTuple2,lvar,uvar],ivar] +              (Unguarded +                (ExpApplication pos +                  [ExpVar pos tTokenInRange+                  ,ExpApplication pos +                    [ExpCon pos tTokenTuple2+                    ,ExpApplication pos [fromEnumVar,lvar]+                    ,ExpApplication pos [fromEnumVar,uvar]]+                  ,ExpApplication pos [fromEnumVar,ivar]]))+              (DeclsParse declsFromEnum)]+          ])+      else {- exactly one constructor -}+        (DeclsParse+          [DeclFun pos (modArity (dropModule tTokenRange) 1)+            [Fun +              [ExpApplication pos [ExpCon pos tTokenTuple2,conLvars,conUvars]]+              (Unguarded +                (foldr ($) +                  (ExpApplication pos [ExpVar pos tTokenReturn,conIvars]) +                  (zipWith3 rangeComb lvars uvars ivars)))+              noDecls]+          ,DeclFun pos (modArity (dropModule tTokenIndex) 2)+            [Fun +              [ExpApplication pos [ExpCon pos tTokenTuple2,conLvars,conUvars]+              ,conIvars] +              (Unguarded+                (foldl (flip ($))+                  (indexExp (head lvars) (head uvars) (head ivars)) +                  (tail (zipWith3 indexComb lvars uvars ivars))))+              noDecls]+          ,DeclFun pos (modArity (dropModule tTokenInRange) 2)+            [Fun +              [ExpApplication pos [ExpCon pos tTokenTuple2,conLvars,conUvars]+              ,conIvars] +              (Unguarded+                (foldr1 andExp (zipWith3 inRangeExp lvars uvars ivars))) +              noDecls]+          ]))+  where+  -- for enumeration type+  lvar:uvar:ivar:_ = traceVars pos+  fromEnumVar = ExpVar pos tTokenLocalFromEnum+  toEnumVar = ExpVar pos tTokenLocalToEnum+  declsFromEnum :: [Decl TraceId]+  declsFromEnum = +    [DeclVarsType [(pos,tTokenLocalFromEnum)] [] +      (TypeCons pos tTokenFun [ty,TypeCons pos tTokenInt []])+    ,DeclFun pos tTokenLocalFromEnum (zipWith funFromEnum constrs [0..])] +  declsToEnum = +    [DeclVarsType [(pos,tTokenLocalToEnum)] [] +      (TypeCons pos tTokenFun [TypeCons pos tTokenInt [],ty])+    ,DeclFun pos tTokenLocalToEnum (zipWith funToEnum constrs [0..])]+  funFromEnum constr num =+    Fun [ExpCon pos (getConstrId constr)] +      (Unguarded (ExpLit pos (LitInteger Boxed num))) noDecls+  funToEnum constr num =+    Fun [ExpLit pos (LitInteger Boxed num)] +      (Unguarded (ExpCon pos (getConstrId constr))) noDecls+  -- for single constructor type+  [constr] = constrs+  conId = getConstrId constr+  arity = constrArity constr+  (lvars,vars1) = splitAt arity (traceVars pos)+  (uvars,vars2) = splitAt arity vars1+  ivars = take arity vars2+  conLvars = ExpApplication pos (ExpCon pos conId:lvars)+  conUvars = ExpApplication pos (ExpCon pos conId:uvars)+  conIvars = ExpApplication pos (ExpCon pos conId:ivars)+  rangeComb :: Exp TraceId -> Exp TraceId -> Exp TraceId -> Exp TraceId +            -> Exp TraceId+  rangeComb l u i cont = +    ExpApplication pos +      [ExpVar pos tTokenGtGtEq+      ,ExpApplication pos +        [ExpVar pos tTokenRange+        ,ExpApplication pos [ExpCon pos tTokenTuple2,l,u]]+      ,ExpLambda pos [i] cont]+  indexExp l u i =+    ExpApplication pos +      [ExpVar pos tTokenIndex+      ,ExpApplication pos [ExpCon pos tTokenTuple2,l,u]+      ,i]+  indexComb :: Exp TraceId -> Exp TraceId -> Exp TraceId -> Exp TraceId +            -> Exp TraceId+  indexComb l u i e =+    ExpApplication pos +      [ExpVar pos tTokenPlus+      ,indexExp l u i+      ,ExpApplication pos +        [ExpVar pos tTokenTimes+        ,ExpApplication pos +          [ExpVar pos tTokenRangeSize+          ,ExpApplication pos [ExpCon pos tTokenTuple2,l,u]]+        ,e]]+  inRangeExp l u i =+    ExpApplication pos +      [ExpVar pos tTokenInRange+      ,ExpApplication pos [ExpCon pos tTokenTuple2,l,u]+      ,i]+  andExp :: Exp TraceId -> Exp TraceId -> Exp TraceId+  andExp e1 e2 = ExpApplication pos [ExpVar pos tTokenAndAnd,e1,e2]++-- ----------------------------------------------------------------------------+-- helper functions++-- infinite list of variables+-- only need not conflict with names of standard class methods+traceVars :: Pos -> [Exp TraceId]+traceVars pos = +  map (ExpVar pos . mkLambdaBound defaultAuxInfo . mkUnqualifiedTokenId . +        ('y':) . show) [1..]+++++++++
+ trans/TraceId.hs view
@@ -0,0 +1,316 @@+module TraceId+  ( TraceId		-- abstract type+  , Fixity(L,R,Pre,Def,None)+  , TyCls(Ty,Cls,Syn)+			-- constructors:+  , mkLambdaBound      	-- :: InitAuxInfo -> TokenId -> TraceId+  , mkModule      	-- :: InitAuxInfo -> TokenId -> TraceId+  , mkClass      	-- :: InitAuxInfo -> TokenId -> TraceId+  , mkTyVar      	-- :: InitAuxInfo -> TokenId -> TraceId+  , mkTyCon             -- :: InitAuxInfo -> TokenId -> TraceId+  , mkField             -- :: InitAuxInfo -> TokenId -> TraceId+  , plus		-- :: TokenId -> AuxiliaryInfo -> TraceId+                        -- modifiers+  , dropModule          -- :: TraceId -> TraceId+  , modLambdaBound      -- :: InitAuxInfo -> TraceId -> TraceId+  , modLetBound         -- :: TraceId -> TraceId+  , modArity            -- :: TraceId -> Int -> TraceId+			-- selectors:+  , tokenId		-- :: TraceId -> TokenId+  , arity		-- :: TraceId -> Maybe Int+  , isLambdaBound	-- :: TraceId -> Bool+  , fixPriority		-- :: TraceId -> Int+  , tFixity             -- :: TraceId -> Fixity+  , tPriority           -- :: TraceId -> Int {0-9}+  , getUnqualified      -- :: TraceId -> String+  , hasInfo             -- :: TraceId -> Bool+  , hasValueInfo        -- :: TraceId -> Bool+  , tyClsInfo           -- :: TraceId -> TyCls+  , isExpandableTypeSynonym -- :: TraceId -> Bool+  , typeSynonymBody     -- :: TraceId -> Maybe TySynBody+  , isTraced            -- :: TraceId -> Bool+  , tTokenCons,tTokenNil,tTokenGtGt,tTokenGtGtEq,tTokenFail+  , tTokenAndAnd,tTokenEqualEqual,tTokenGreaterEqual,tTokenGreater,tTokenMinus+  , tTokenTrue,tTokenFalse,tTokenEQ,tTokenCompare+  ,tTokenLocalFromEnum,tTokenInt,tTokenMinBound,tTokenMaxBound+  ,tTokenFromEnum,tTokenToEnum,tTokenEnumFrom,tTokenEnumFromThen+  ,tTokenEnumFromTo,tTokenEnumFromThenTo,tTokenError+  ,tTokenCompose,tTokenShowsPrec,tTokenShowParen,tTokenShowChar+  ,tTokenShowString,tTokenReadsPrec,tTokenReadParen,tTokenYield+  ,tTokenAlt,tTokenThenAp,tTokenThenLex,tTokenRange,tTokenIndex,tTokenInRange+  ,tTokenMap,tTokenLocalToEnum,tTokenTuple2,tTokenFun+  ,tTokenRangeSize,tTokenReturn,tTokenPlus,tTokenTimes -- :: TraceId+  ) where++import TokenId +  (TokenId,mkQualifiedTokenId,extractV,dropM,t_Colon,t_List,t_gtgt,t_gtgteq+  ,tfail,t_andand,t_equalequal,t_greater,t_greaterequal,tminus,tTrue+  ,tFalse,tEQ,tcompare,visImport,tInt,tminBound,tmaxBound+  ,tfromEnum,ttoEnum,tenumFrom,tenumFromThen,tenumFromTo+  ,tenumFromThenTo,t_error,t_dot,tshowsPrec,tshowParen,tshowChar+  ,tshowString,treadsPrec,treadParen,trange,tindex,tinRange,t_Tuple,t_Arrow)+import AuxTypes (AuxiliaryInfo(..),InitAuxInfo(..),Fixity(..),TyCls(..)+                ,TySynBody,emptyAux,untracedEmptyAux)+import Data.Maybe (isJust)+import SysDeps (unpackPS)+++data TraceId = TI TokenId (Maybe AuxiliaryInfo)++instance Eq TraceId where+  TI t1 _ == TI t2 _ = t1 == t2+++-- construction functions++mkLambdaBound :: InitAuxInfo -> TokenId -> TraceId+mkLambdaBound (InitAuxInfo tr) t = +  TI t (Just (Value{ args=(-1), fixity=Def, priority=9, letBound=False+		   , traced=tr}))++plus :: TokenId -> AuxiliaryInfo -> TraceId+t `plus` aux = TI t (Just aux)++mkModule :: InitAuxInfo -> TokenId -> TraceId+mkModule = mkLambdaBound++mkClass :: InitAuxInfo -> TokenId -> TraceId+mkClass = mkLambdaBound++mkTyVar :: InitAuxInfo -> TokenId -> TraceId+mkTyVar = mkLambdaBound++mkTyCon :: InitAuxInfo -> TokenId -> TraceId+mkTyCon = mkLambdaBound++mkField :: InitAuxInfo -> TokenId -> TraceId+mkField = mkLambdaBound++++-- modification functions++-- drop qualifier+dropModule :: TraceId -> TraceId+dropModule (TI tokenId aux) = TI (dropM tokenId) aux++modLambdaBound :: InitAuxInfo -> TraceId -> TraceId+modLambdaBound iai (TI token (Just aux@Value{})) = +  TI token (Just aux{letBound=False})+modLambdaBound iai (TI token _) = mkLambdaBound iai token++modLetBound :: TraceId -> TraceId+modLetBound (TI token (Just aux)) = TI token (Just aux{letBound=True,args=0})+modLetBound (TI token Nothing) = error "modLetBound"++modArity :: TraceId -> Int -> TraceId+modArity (TI token (Just aux)) arity = TI token (Just aux{args=arity})+modArity (TI token Nothing) arity = error "modArity"++-- selection functions++tokenId :: TraceId -> TokenId+tokenId (TI t _) = t++arity :: TraceId -> Maybe Int+arity (TI _ (Just Value{args=a})) = Just a+arity (TI _ _)  = Nothing+ +isLambdaBound :: TraceId -> Bool+isLambdaBound (TI _ (Just Value{letBound=b})) = not b+isLambdaBound (TI _ Nothing) = +  error "TraceId.isLambdaBound: no aux information"++tFixity :: TraceId -> Fixity+tFixity (TI _ Nothing) = Def+tFixity (TI _ (Just info)) = fixity info++tPriority :: TraceId -> Int {- 0-9 -}+tPriority (TI _ Nothing) = 9+tPriority (TI _ (Just info)) = priority info++fixPriority :: TraceId -> Int+fixPriority (TI _ Nothing) = 3	-- default fixity and priority+fixPriority (TI _ (Just info)) = encode (fixity info) (priority info)+  where+    encode Def     _ = 3+    encode L       n = 2 + (n*4)+    encode R       n = 1 + (n*4)+    encode None    n = 0 + (n*4)+    encode (Pre _) n = 0 + (n*4)++getUnqualified :: TraceId -> String+getUnqualified = reverse . unpackPS . extractV . tokenId++hasInfo :: TraceId -> Bool+hasInfo (TI _ aux) = isJust aux++hasValueInfo :: TraceId -> Bool+hasValueInfo (TI _ (Just Value{})) = True+hasValueInfo (TI _ _) = False++tyClsInfo :: TraceId -> TyCls+tyClsInfo (TI _ (Just (TyCls tyCls))) = tyCls++isExpandableTypeSynonym :: TraceId -> Bool+isExpandableTypeSynonym (TI _ (Just (TyCls (Syn n _)))) = n > 0+isExpandableTypeSynonym _ = False++typeSynonymBody :: TraceId -> Maybe TySynBody+typeSynonymBody (TI _ (Just (TyCls (Syn _ body)))) = Just body+typeSynonymBody _ = Nothing++typeSynonymHelpers :: TraceId -> Maybe Int+typeSynonymHelpers (TI _ (Just (TyCls (Syn helpers _)))) = Just helpers+typeSynonymHelpers _ = Nothing++isTraced :: TraceId -> Bool+isTraced (TI _ (Just Value{traced=tr})) = tr++-- TraceId versions of some hardcoded tokens ++tTokenCons :: TraceId+tTokenCons = t_Colon `plus` untracedEmptyAux{args=2}++tTokenNil :: TraceId+tTokenNil = t_List `plus` untracedEmptyAux{args=0}++tTokenGtGt :: TraceId+tTokenGtGt = t_gtgt `plus` untracedEmptyAux++tTokenGtGtEq :: TraceId+tTokenGtGtEq = t_gtgteq `plus` untracedEmptyAux++tTokenFail :: TraceId+tTokenFail = tfail `plus` untracedEmptyAux++tTokenAndAnd :: TraceId+tTokenAndAnd = t_andand `plus` untracedEmptyAux{args=2}++tTokenEqualEqual :: TraceId+tTokenEqualEqual = t_equalequal `plus` untracedEmptyAux++tTokenGreater :: TraceId+tTokenGreater = t_greater `plus` untracedEmptyAux++tTokenGreaterEqual :: TraceId+tTokenGreaterEqual = t_greaterequal `plus` untracedEmptyAux++tTokenMinus :: TraceId+tTokenMinus = tminus `plus` untracedEmptyAux++tTokenTrue :: TraceId+tTokenTrue = tTrue `plus` untracedEmptyAux{args=0}++tTokenFalse :: TraceId+tTokenFalse = tFalse `plus` untracedEmptyAux{args=0}++tTokenEQ :: TraceId+tTokenEQ = tEQ `plus` untracedEmptyAux{args=0}++tTokenCompare :: TraceId+tTokenCompare = tcompare `plus` untracedEmptyAux++tTokenLocalFromEnum :: TraceId+tTokenLocalFromEnum = visImport "localFromEnum" `plus` untracedEmptyAux{args=1}++tTokenInt :: TraceId+tTokenInt = tInt `plus` untracedEmptyAux++tTokenMinBound :: TraceId+tTokenMinBound = tminBound `plus` untracedEmptyAux++tTokenMaxBound :: TraceId+tTokenMaxBound = tmaxBound `plus` untracedEmptyAux++tTokenFromEnum :: TraceId+tTokenFromEnum = tfromEnum `plus` untracedEmptyAux++tTokenToEnum :: TraceId+tTokenToEnum = ttoEnum `plus` untracedEmptyAux++tTokenEnumFrom :: TraceId+tTokenEnumFrom = tenumFrom `plus` untracedEmptyAux++tTokenEnumFromTo :: TraceId+tTokenEnumFromTo = tenumFromTo `plus` untracedEmptyAux++tTokenEnumFromThen :: TraceId+tTokenEnumFromThen = tenumFromThen `plus` untracedEmptyAux++tTokenEnumFromThenTo :: TraceId+tTokenEnumFromThenTo = tenumFromThenTo `plus` untracedEmptyAux++tTokenError :: TraceId+tTokenError = t_error `plus` untracedEmptyAux{args=1}++tTokenCompose :: TraceId+tTokenCompose = t_dot `plus` untracedEmptyAux{args=3}++tTokenShowsPrec :: TraceId+tTokenShowsPrec = tshowsPrec `plus` untracedEmptyAux++tTokenShowParen :: TraceId+tTokenShowParen = tshowParen `plus` untracedEmptyAux{args=2}++tTokenShowString :: TraceId+tTokenShowString = tshowString `plus` untracedEmptyAux{args=0}++tTokenShowChar :: TraceId+tTokenShowChar = tshowChar `plus` untracedEmptyAux{args=0}++tTokenReadsPrec :: TraceId+tTokenReadsPrec = treadsPrec `plus` untracedEmptyAux++tTokenReadParen :: TraceId+tTokenReadParen = treadParen `plus` untracedEmptyAux{args=2}++tTokenYield :: TraceId+tTokenYield = +  mkQualifiedTokenId "PreludeBasic" "yield" `plus` untracedEmptyAux{args=2}++tTokenAlt :: TraceId+tTokenAlt = +  mkQualifiedTokenId "PreludeBasic" "alt" `plus` untracedEmptyAux{args=3}++tTokenThenLex :: TraceId+tTokenThenLex = +  mkQualifiedTokenId "PreludeBasic" "thenLex" `plus` untracedEmptyAux{args=2}++tTokenThenAp :: TraceId+tTokenThenAp = +  mkQualifiedTokenId "PreludeBasic" "thenAp" `plus` untracedEmptyAux{args=0}++tTokenRange :: TraceId+tTokenRange = trange `plus` untracedEmptyAux++tTokenIndex :: TraceId+tTokenIndex = tindex `plus` untracedEmptyAux++tTokenInRange :: TraceId+tTokenInRange = tinRange `plus` untracedEmptyAux++tTokenMap :: TraceId+tTokenMap = +  mkQualifiedTokenId "PreludeBasic" "map" `plus` untracedEmptyAux{args=2}++tTokenLocalToEnum :: TraceId+tTokenLocalToEnum = visImport "localToEnum" `plus` untracedEmptyAux{args=1}++tTokenTuple2 :: TraceId+tTokenTuple2 = t_Tuple 2 `plus` untracedEmptyAux{args=2}++tTokenFun :: TraceId+tTokenFun = t_Arrow `plus` untracedEmptyAux++tTokenRangeSize :: TraceId+tTokenRangeSize = mkQualifiedTokenId "Ix" "rangeSize" `plus` untracedEmptyAux++tTokenReturn :: TraceId+tTokenReturn = mkQualifiedTokenId "PreludeBasic" "return" `plus` untracedEmptyAux++tTokenPlus :: TraceId+tTokenPlus = mkQualifiedTokenId "PreludeBasic" "+" `plus` untracedEmptyAux++tTokenTimes :: TraceId+tTokenTimes = mkQualifiedTokenId "PreludeBasic" "*" `plus` untracedEmptyAux
+ trans/Wrapper.hs view
@@ -0,0 +1,104 @@+{- --------------------------------------------------------------------------- + Prepare a parsed module ready for the tracing transformation, when+ the module is not to be traced at all, but rather the original+ functions will be called and wrapped.  Essentially, we need to strip+ the module down to reveal just its interface.++ We assume that any function exported from the module must have a+ top-level type signature.  (If not, then it cannot be wrapped, so emit+ an error message.)++ Preparation of the syntax tree consists of:+   * traverse the export list+   * for each datatype exported abstractly, generate type-wrapping functions+   * for each datatype exported concretely, *** TO DO ***+   * for each function exported, grab its type signature and generate a+     "foreign import haskell" decl from it+   * in each class instance, generate "f.i.h" functions for each method+   * delete all imports, except those that bring a needed type into scope+   * add a new import of the original untraced version of this module+   * delete all other decls++ We do need to chase imports to resolve references to (datatype)+ identifiers, but mainly so that we can delete most imports, keeping+ only those that bring needed datatypes into scope.  Thus, we end up+ with two import-chasing phases, once before wrapping, and another+ afterwards (much reduced).++ After preparation, the module can be passed through the normal tracing+ transformation, which already knows how to handle "foreign import haskell".+ (Except for the new type-wrapping functions, which get added without+ transformation.)++ *** Need to think about when to create .hx file.  In this traversal?+     Or do we gather imported environment as usual (after traversal?).++--------------------------------------------------------------------------- -}+module Wrapper+  ( prepareWrapping+  ) where++import Data.Maybe+import Syntax+import TokenId+import Extra++prepareWrapping :: String	-- filename of module+		-> Module TokenId+		-> Module TokenId++prepareWrapping filename+    (Module pos modId exports impDecls fixDecls decls)+  =  Module pos modId exports impDecls'  []     decls'+  where impDecls' = mkImportOriginal modId : impDecls+        decls'    = traverse modId exports decls++mkImportOriginal :: TokenId -> ImpDecl TokenId+mkImportOriginal modId =+  ImportQ (noPos, mkUnqualifiedTokenId ("TraceOrig"++show modId)) (Hiding [])++traverse :: TokenId -> Maybe [Export TokenId] -> Decls TokenId -> Decls TokenId+traverse modId exports (DeclsParse ds) = DeclsParse (concatMap walk ds)+  where+    walk (DeclType lhs rhs) = []				-- nyi+    walk (DeclClass pos ctxs cid tyvars fundeps decls) = []	-- nyi+    walk (DeclInstance pos ctxs cid insts decls) = []		-- nyi+    walk (DeclData newty ctxs lhs constrs posids) | exported simple lhs =+          DeclData Nothing [] lhs [newconstr] [] : []+      where simple (Simple _ tycon tyvars) = Just tycon+            newconstr = Constr noPos (fromJust (simple lhs))+                                     [(Nothing, qualify (simpleToType lhs))]+            qualify (TypeCons pos tcId tvars) =+                     TypeCons pos (mkQualifiedTokenId (show modId) (show tcId))+                                  tvars+    walk (DeclForeignImp pos conv cname var int safe typ hname)+         | exported Just var = mkForeignHaskell modId [] typ (pos,var): []+    walk (DeclVarsType posids ctxs typ) | not (null vars) =+          map (mkForeignHaskell modId ctxs typ) vars+      where vars = filter (exported (\ (_,t)->Just t)) posids+    walk (DeclPat alt) = []		-- delete pattern decls+    walk (DeclFun pos var funs) = []	-- delete function decls+    walk (DeclFixity (fixity,prec,vars)) | not (null expvars) =+          DeclFixity (fixity,prec,expvars): []+      where expvars = filter (exported varop) vars+            varop (FixVar _ id) = Just id+            varop _             = Nothing+    walk _ = []++    exported :: (a -> Maybe TokenId) -> a -> Bool+    exported f x = case exports of+                     Nothing   -> True+                     Just exps -> case f x of+                                    Nothing -> False+                                    Just v  -> (v `within`) `any` exps+      where tid `within` (ExportEntity _ (EntityVar _ t))       = tid==t+            tid `within` (ExportEntity _ (EntityConClsAll _ t)) = tid==t+            tid `within` (ExportEntity _ (EntityConClsSome _ t ss)) =+					 tid==t || tid `elem` map snd ss+            tid `within` (ExportModid _ _) = False	-- inaccurate...++-- TO DO: merge ctxs into typ for FFI signature+mkForeignHaskell :: TokenId -> [Context TokenId] -> Type TokenId+                 -> (Pos,TokenId) -> Decl TokenId+mkForeignHaskell mod ctxs typ (pos,var) =+    DeclForeignImp pos Haskell (show mod++'.':show var) var 0 Safe typ var