Changeset 15434 for src/Pugs/AST.hs

Timestamp:

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

Author:

audreyt

Message:

* Pugs.AST: Make oldVal boxable.
* Pugs.Prim: Move op1 "vv"'s implementation to the Value instance in Pugs.AST.

Files:

• src/Pugs/AST.hs (modified) (1 diff)

src/Pugs/AST.hs

@@ -40 +40 @@
 import Pugs.AST.Pad
 import Pugs.Val hiding (Val, Param, listVal) -- (val, castVal, formatVal, PureBit, PureBool, PureStr, PureInt, PureNum, Capt(..), ValCapt, Feed(..), ValFeed, emptyFeed, Sig(..), SigParam(..), ParamAccess(..), ParamDefault(..))
+import qualified Pugs.Val as Val
 import Pugs.Meta ()
+import Pugs.Class
+
+instance Value (Val.Val) where
+    fromVV = return
+    fromSV = return . mkVal
+    fromVal v = case v of
+        VV x@(MkInvocant x' _) -> case fromTypeable x' of
+            Just v  -> fromVal v
+            _       -> return x
+        VUndef      -> return . mkVal $ ()
+        VBool x     -> return . mkVal $ ((cast x) :: Val.PureBit)
+        VInt x      -> return . mkVal $ ((cast x) :: Val.PureInt)
+        VNum x      -> return . mkVal $ ((cast x) :: Val.PureNum)
+        VRat x      -> return . mkVal $ ((cast x) :: Val.PureNum)
+        VStr x      -> return . mkVal $ ((cast x) :: Val.PureStr)
+        PerlSV x    -> return . mkVal $ x
+        _           -> return . mkVal $ v
+    doCast = fromVal
+    castV  = VV
+
+data OldValResponder = OldValResponder deriving Typeable
+instance ResponderInterface Eval OldValResponder where
+    dispatch _          = dispatchOldVal
+    fromMethodList _    = return OldValResponder
+    toNameList _        = []
+
+instance Boxable Eval Val where
+    mkObj sv = MkInvocant sv (MkResponder (return OldValResponder))
+
+dispatchOldVal :: Val.Val -> Call -> Eval Val.Val
+dispatchOldVal inv call = do
+    fail $ "Dispatch failed - " ++ show (miName call)
 
 {-|