Changeset 15439

Timestamp:

03/04/07 14:40:43 (21 months ago)

Author:

audreyt

Message:

* Pugs.Class: Allow the right hand side of ./ to be polymorphic,

thus allowing two convenient callconv forms (more to come):

obj ./ meth
obj ./ (meth, pos, nam)

Files:

• src/Pugs/Class.hs (modified) (5 diffs)

src/Pugs/Class.hs

@@ -1 @@
-{-# OPTIONS_GHC -fglasgow-exts -cpp #-}
+{-# OPTIONS_GHC -fglasgow-exts -fparr #-}
 
 {-|
@@ -24 +24 @@
 import MO.Compile
 import MO.Compile.Class
-import MO.Util
+import MO.Util hiding (traceM, traceShow)
 import Pugs.Internals
 import Pugs.AST.Eval
 import Control.Monad.Fix
+import qualified Data.Map as Map
+import qualified Data.Typeable as Typeable
 
 class (Show a, Typeable a, Ord a, Typeable1 m, Monad m) => Boxable m a | a -> m where
@@ -44 +46 @@
 
     fromObj :: Invocant m -> m a
-    fromObj (MkInvocant x _) = fromTypeable x
+    fromObj (MkInvocant x _) = case Typeable.cast x of
+        Just y -> return y
+        _      -> fail $ "Cannot coerce from " ++ (show $ typeOf x) ++ " to " ++ (show $ typeOf (undefined :: a))
 
 (...) :: Boxable m b => String -> (a -> b) -> (ID, a -> m (Invocant m))
@@ -110 +114 @@
     }
 
-(./) :: (Typeable1 m, Monad m) => Invocant m -> ID -> m (Invocant m)
-inv ./ meth = ivDispatch inv $ MkMethodInvocation meth (mkArgs [])
+(./) :: ((:>:) (MethodInvocation Eval) a) => Invocant Eval -> a -> Eval (Invocant Eval)
+x ./ y = ivDispatch x (cast y)
 
 type PureClass = MI Eval
@@ -126 +130 @@
     ]
 
+instance ((:>:) (MethodInvocation Eval)) ByteString where
+    cast = (`MkMethodInvocation` CaptSub{ c_feeds = [::] }) . cast
+
+instance ((:>:) (MethodInvocation Eval) (ByteString, [Invocant Eval], Map ID (Invocant Eval))) where
+    cast (meth, pos, named) = MkMethodInvocation (cast meth) CaptSub{ c_feeds = [: MkFeed (toP pos) (Map.map (\x -> [:x:]) named) :]}
+