Changeset 15393

Timestamp:

03/01/07 14:48:55 (21 months ago)

Author:

audreyt

Message:

* Refactor ^{Str and} Class into their own modules.

Files:

• Pugs.cabal.in (modified) (1 diff)
• src/Pugs/AST/Internals.hs (modified) (2 diffs)
• src/Pugs/Class.hs (modified) (2 diffs)
• src/Pugs/Meta (added)
• src/Pugs/Meta.hs (modified) (2 diffs)
• src/Pugs/Meta/Class.hs (added)
• src/Pugs/Meta/Str.hs (added)
• src/Pugs/Val.hs (modified) (2 diffs)

Pugs.cabal.in

@@ -12 +12 @@
 author: Audrey Tang <autrijus@autrijus.org>
 tested-with: GHC -any
-exposed-modules: Pugs Pugs.AST Pugs.AST.Internals Pugs.AST.Internals.Instances Pugs.AST.Pad Pugs.AST.Pos Pugs.AST.Prag Pugs.AST.SIO Pugs.AST.Scope Pugs.AST.Utils Pugs.AST.Eval Pugs.Bind Pugs.Class.C3 Pugs.Class Pugs.CodeGen Pugs.CodeGen.JSON Pugs.CodeGen.PIL1 Pugs.CodeGen.PIR Pugs.CodeGen.PIR.Prelude Pugs.Prelude Pugs.CodeGen.Perl5 Pugs.CodeGen.YAML Pugs.Compat Pugs.Compile Pugs.Compile.Pugs Pugs.Config Pugs.Cont Pugs.DeepSeq Pugs.Embed Pugs.Embed.Haskell Pugs.Embed.Parrot Pugs.Embed.Perl5 Pugs.Embed.Pugs Pugs.Eval Pugs.Eval.Var Pugs.External Pugs.External.Haskell Pugs.Help Pugs.Internals Pugs.Internals.Cast Pugs.Internals.ID Pugs.Internals.String Pugs.Internals.Global Pugs.Internals.Monads Pugs.Junc Pugs.Lexer Pugs.Monads Pugs.PIL1 Pugs.PIL1.Instances Pugs.Parser Pugs.Parser.Charnames Pugs.Parser.Operator Pugs.Parser.Number Pugs.Parser.Program Pugs.Parser.Types Pugs.Parser.Unsafe Pugs.Parser.Export Pugs.Parser.Doc Pugs.Parser.Literal Pugs.Parser.Util Pugs.Pretty Pugs.Prim Pugs.Prim.Code Pugs.Prim.Eval Pugs.Prim.FileTest Pugs.Prim.Keyed Pugs.Prim.Lifts Pugs.Prim.List Pugs.Prim.Match Pugs.Prim.Numeric Pugs.Prim.Param Pugs.Prim.Yaml Pugs.Rule Pugs.Run Pugs.Run.Args Pugs.Run.Perl5 Pugs.Shell Pugs.Types Pugs.Version Emit.Common Emit.PIR Emit.PIR.Instances Pugs.Val Pugs.Val.Code Pugs.Val.Base Pugs.Exp MO.Util MO.Base MO.Compile MO.Run MO.Compile.Attribute MO.Compile.Role MO.Compile.Class
+exposed-modules: Pugs Pugs.AST Pugs.AST.Internals Pugs.AST.Internals.Instances Pugs.AST.Pad Pugs.AST.Pos Pugs.AST.Prag Pugs.AST.SIO Pugs.AST.Scope Pugs.AST.Utils Pugs.AST.Eval Pugs.Bind Pugs.Class.C3 Pugs.Class Pugs.CodeGen Pugs.CodeGen.JSON Pugs.CodeGen.PIL1 Pugs.CodeGen.PIR Pugs.CodeGen.PIR.Prelude Pugs.Prelude Pugs.CodeGen.Perl5 Pugs.CodeGen.YAML Pugs.Compat Pugs.Compile Pugs.Compile.Pugs Pugs.Config Pugs.Cont Pugs.DeepSeq Pugs.Embed Pugs.Embed.Haskell Pugs.Embed.Parrot Pugs.Embed.Perl5 Pugs.Embed.Pugs Pugs.Eval Pugs.Eval.Var Pugs.External Pugs.External.Haskell Pugs.Help Pugs.Internals Pugs.Internals.Cast Pugs.Internals.ID Pugs.Internals.String Pugs.Internals.Global Pugs.Internals.Monads Pugs.Junc Pugs.Lexer Pugs.Meta Pugs.Meta.Class Pugs.Meta.Str Pugs.Monads Pugs.PIL1 Pugs.PIL1.Instances Pugs.Parser Pugs.Parser.Charnames Pugs.Parser.Operator Pugs.Parser.Number Pugs.Parser.Program Pugs.Parser.Types Pugs.Parser.Unsafe Pugs.Parser.Export Pugs.Parser.Doc Pugs.Parser.Literal Pugs.Parser.Util Pugs.Pretty Pugs.Prim Pugs.Prim.Code Pugs.Prim.Eval Pugs.Prim.FileTest Pugs.Prim.Keyed Pugs.Prim.Lifts Pugs.Prim.List Pugs.Prim.Match Pugs.Prim.Numeric Pugs.Prim.Param Pugs.Prim.Yaml Pugs.Rule Pugs.Run Pugs.Run.Args Pugs.Run.Perl5 Pugs.Shell Pugs.Types Pugs.Version Emit.Common Emit.PIR Emit.PIR.Instances Pugs.Val Pugs.Val.Code Pugs.Val.Base Pugs.Exp MO.Util MO.Base MO.Compile MO.Run MO.Compile.Attribute MO.Compile.Role MO.Compile.Class
 buildable: True
 c-sources: src/pcre/pcre.c __PERL5_C__

src/Pugs/AST/Internals.hs

@@ -101 +101 @@
 import Pugs.AST.SIO
 import Pugs.Embed.Perl5
+import Pugs.Meta ()
 import qualified Pugs.Val as Val
 import qualified Data.ByteString.Char8 as Str
@@ -248 +249 @@
 
 toVV' :: Val -> Eval Val
-toVV' VUndef   = return $ VV $ Val.val $ ()
-toVV' (VBool v)= return $ VV $ Val.val $ ((cast v) :: Val.PureBit)
-toVV' (VInt v) = return $ VV $ Val.val $ ((cast v) :: Val.PureInt)
-toVV' (VNum v) = return $ VV $ Val.val $ ((cast v) :: Val.PureNum)
-toVV' (VRat v) = return $ VV $ Val.val $ ((cast v) :: Val.PureNum)
-toVV' (VStr v) = return $ VV $ Val.val $ ((cast v) :: Val.PureStr)
-toVV' x = error $ "don't know how to toVV': " ++ show x
-
+toVV' VUndef    = return . VV . Val.val $ ()
+toVV' (VBool v) = return . VV . Val.val $ ((cast v) :: Val.PureBit)
+toVV' (VInt v)  = return . VV . Val.val $ ((cast v) :: Val.PureInt)
+toVV' (VNum v)  = return . VV . Val.val $ ((cast v) :: Val.PureNum)
+toVV' (VRat v)  = return . VV . Val.val $ ((cast v) :: Val.PureNum)
+toVV' (VStr v)  = return . VV . Val.val $ ((cast v) :: Val.PureStr)
+toVV' x         = fail $ "don't know how to toVV': " ++ show x
 
 getArrayIndex :: Int -> Maybe (IVar VScalar) -> Eval IArray -> Maybe (Eval b) -> Eval (IVar VScalar)

src/Pugs/Class.hs

@@ -14 +14 @@
 module Pugs.Class
     ( module Pugs.Class
+    , module Pugs.AST.Eval
     , module MO.Run
     , module MO.Compile
@@ -88 +89 @@
 (./) :: (Typeable1 m, Monad m) => Invocant m -> ID -> m (Invocant m)
 inv ./ meth = ivDispatch inv $ MkMethodInvocation meth (mkArgs [])
+
+type PureClass = MI Eval
+
+instance Boxable Eval PureClass where
+    classOf _ = _PureClass
+
+_PureClass :: PureClass
+_PureClass = mkBoxClass "Class"
+    [ "HOW"         ... (const _PureClass :: PureClass -> PureClass)
+    ]
+

src/Pugs/Meta.hs

@@ -2 +2 @@
 
 {-|
-    Perl 6 Metaclasses.
+    Perl 6 Meta-object definitions.
 
 >   And though I oft have passed them by,
@@ -10 +10 @@
 -}
 
+module Pugs.Meta
+    ( module Pugs.Meta.Str
+    , module Pugs.Meta.Class
+    ) where
+
+import Pugs.Meta.Str
+import Pugs.Meta.Class
+

src/Pugs/Val.hs

@@ -14 +14 @@
 ) where
 import Pugs.Class
-import Pugs.AST.Eval
 import Pugs.Val.Code
 import Pugs.Internals
 import Text.PrettyPrint
-import qualified Data.ByteString.Char8 as Str
 
 type Val = Invocant Eval
@@ -106 +104 @@
 instance Boxable Eval PureBit
 instance Boxable Eval ValCapt
-
-type PureClass = MI Eval
-instance Boxable Eval PureClass where
-    classOf _ = _PureClass
-
-_PureClass :: PureClass
-_PureClass = mkBoxClass "Class"
-    [ "HOW"         ... (const _PureClass :: PureClass -> PureClass)
-    ]
-
-instance Boxable Eval PureStr where
-    classOf _ = _StrClass
-
-_StrClass :: PureClass
-_StrClass = mkBoxClass "Str"
-    [ "reverse"     ... (MkStr . Str.reverse . unStr)
-    , "HOW"         ... (const _StrClass)
-    ]
 
 {-