Changeset 12317 for src/Pugs/CodeGen

Timestamp:

08/16/06 19:28:24 (2 years ago)

Author:

audreyt

Message:

* Glorious refactoring of the Var type.

Previously, Var is type synonym to String, and all package

lookups, OUTER

handling, sigil and twigil parsing etc were done in an extremely adhoc way with String operations.

Now we split Var into several parts.
Take "&Moose::Elk::infix:<antler>" as an example:

v_sigil

VarSigil? -- SScalar

v_twigil

VarTwigil? -- TNone

v_package

Pkg -- ["Moose", "Elk"]

v_categ

VarCateg? -- C_infix

v_name

ID -- "antler"

The names are stored as interned ByteStrings? for fast comparison.

All involved types are changed from String to new types as well,

such as (envPackage

Pkg).

Files:

• src/Pugs/CodeGen/PIR.hs (modified) (9 diffs)

src/Pugs/CodeGen/PIR.hs

@@ -17 +17 @@
 import Pugs.AST
 import Pugs.Types
-import Pugs.Eval.Var
 import Pugs.PIL1
 import Emit.PIR.Instances ()
@@ -28 +27 @@
 import Pugs.Run (getLibs)
 import DrIFT.YAML
+import qualified Data.ByteString.Char8 as Str
 
 type CodeGen a = WriterT [Stmt] (ReaderT TEnv IO) a
@@ -125 +125 @@
 
 prmToPad :: Param -> (VarName, Expression)
-prmToPad prm = (paramName prm, ExpLV (VAR $ prmToIdent prm))
+prmToPad prm = (cast (paramName prm), ExpLV (VAR $ prmToIdent prm))
+
+isQualified :: String -> Maybe (String, String)
+isQualified name
+    | Just (post, pre) <- breakOnGlue "::" (reverse name) =
+    let (sigil, pkg) = span (not . isAlphaNum) preName
+        name'       = possiblyFixOperatorName (cast $ sigil ++ postName)
+        preName     = reverse pre
+        postName    = reverse post
+    in case takeWhile isAlphaNum pkg of
+        "OUTER"     -> Nothing
+        "CALLER"    -> Nothing
+        _           -> Just (pkg, cast name')
+isQualified _ = Nothing
 
 instance Translate PIL_Decl Decl where
-    trans (PSub name styp params lvalue ismulti body) | Just (pkg, name') <- isQualified name = do
-        declC <- trans $ PSub name' styp params lvalue ismulti body
-        return $ DeclNS pkg [declC]
+    trans (PSub name styp params lvalue ismulti body) 
+        | Just (pkg, name') <- isQualified name = do
+            declC <- trans $ PSub (cast name') styp params lvalue ismulti body
+            return $ DeclNS (cast pkg) [declC]
     trans (PSub name styp params _ _ body) = do
         (_, stmts)  <- listen $ do
@@ -156 +170 @@
         | MkCode{ subBody = Syn "block" [ Ann _ exp ] } <- code
         , App (Var var) Nothing [] <- exp
-        = fmap ExpLV (trans (PVar var))
+        = fmap ExpLV (trans (PVar $ cast var))
     trans (PVal (VList vs)) = do
         pmc <- genArray "vlist"
@@ -166 +180 @@
 
 instance Translate PIL_LValue LValue where
-    trans (PVar name) | Just (pkg, name') <- isQualified name = do
+    trans (PVar name) | Just (pkg, name') <- isQualified (cast name) = do
         [globL] <- genLabel ["glob"]
         pmc     <- genScalar "glob"
@@ -186 +200 @@
     trans (PVar name) = do
         pmc     <- genScalar "lex"
-        tellIns $ pmc <-- "find_name" $ [lit $ possiblyFixOperatorName name]
+        tellIns $ pmc <-- "find_name" $ [lit $ possiblyFixOperatorName $ cast name]
         return pmc
     trans (PAssign [lhs] rhs) = do
@@ -236 +250 @@
     trans x = transError x
 
+instance LiteralClass Var Expression where
+    lit = ExpLit . LitStr . cast
+
+instance LiteralClass ByteString Expression where
+    lit = ExpLit . LitStr . cast
+
 -- XXX - slow way of implementing "return"
 wrapSub :: SubType -> CodeGen () -> CodeGen ()
@@ -266 +286 @@
 
 prmToIdent :: Param -> String
-prmToIdent = render . varText . paramName
+prmToIdent = render . varText . cast. paramName
 
 storeLex :: TParam -> CodeGen ()
@@ -280 +300 @@
                 tellIns $ VAR name <:= expC
         tellLabel defC
-    tellIns $ "store_lex" .- [lit var, bare name]
+    tellIns $ "store_lex" .- [lit (cast var :: VarName), bare name]
     where
     var     = paramName prm