Changeset 15407

Timestamp:

03/02/07 11:34:17 (21 months ago)

Author:

gaal

Message:

* fixed-point golf: get "HOW" and "WHICH" methods on all pure

classes automatically.

Location:

src/Pugs

Files:

• Class.hs (modified) (3 diffs)
• Meta/Str.hs (modified) (1 diff)

src/Pugs/Class.hs

@@ -19 +19 @@
     , module MO.Compile.Class
     , module MO.Util
+    , module Control.Monad.Fix
     ) where
 import MO.Run hiding (__)
@@ -26 +27 @@
 import Pugs.Internals
 import Pugs.AST.Eval
+import Control.Monad.Fix
 
 class (Show a, Typeable a, Ord a, Typeable1 m, Monad m) => Boxable m a | a -> m where
@@ -73 +75 @@
     }
 
+mkBoxPureClass :: forall a1 (m :: * -> *) a (m1 :: * -> *).
+    ( Boxable m a1
+    , Boxable m a
+    , Codeable m1 (HsCode m)
+    , Typeable1 m1
+    ) => String -> [(ID, a1 -> m (Invocant m))] -> a -> MI m1
+mkBoxPureClass cls methods self =
+    mkBoxClass cls methods'
+    where
+        methods' = methods ++
+            [ "HOW"         ... (const self)
+            , "WHICH"       ... id
+            ]
+
 mkBoxMethod :: forall t (m1 :: * -> *) (m :: * -> *).
     ( Method m (SimpleMethod m)

src/Pugs/Meta/Str.hs

@@ -10 +10 @@
 
 _StrClass :: PureClass
-_StrClass = mkBoxClass "Str"
+_StrClass = fix $ mkBoxPureClass "Str"
     [ "reverse"     ... (MkStr . Str.reverse . unStr)
-    , "HOW"         ... (const _StrClass)
-    , "WHICH"       ... id
     ]