Changeset 5168

Timestamp:

07/04/05 00:35:11 (4 years ago)

Author:

autrijus

svk:copy_cache_prev:

6965

Message:

* qualified names now dealt with consistently; new and

improved API moved to Pugs.Eval.Var:

isQualified, packageOf, qualify, toPackage, toQualified,

Location:

src/Pugs

Files:

• Compile.hs (modified) (2 diffs)
• Eval/Var.hs (modified) (3 diffs)

src/Pugs/Compile.hs

@@ -16 +16 @@
 import Pugs.Types
 import Pugs.Eval
+import Pugs.Eval.Var
 import Emit.PIR
 import Text.PrettyPrint
@@ -428 +429 @@
 varText x           = error $ "invalid name: " ++ x
 
-packageOf :: String -> String
-packageOf name = case isQualified name of
-    Just (pkg, _)   -> pkg
-    _               -> "main"
-
-qualify :: String -> String
-qualify name = case isQualified name of
-    Just _  -> name
-    _       -> let (sigil, name') = span (not . isAlphaNum) name
-        in sigil ++ "main::" ++ name'
-
-isQualified :: String -> Maybe (String, String)
-isQualified name | Just (post, pre) <- breakOnGlue "::" (reverse name) =
-    let (sigil, pkg) = span (not . isAlphaNum) preName
-        name'       = possiblyFixOperatorName (sigil ++ postName)
-        preName     = reverse pre
-        postName    = reverse post
-    in Just (pkg, name')
-isQualified _ = Nothing
-
 initTEnv :: Eval TEnv
 initTEnv = do

src/Pugs/Eval/Var.hs

@@ -5 +5 @@
     findVar, findVarRef,
     evalVar, findSub, evalExpType,
+    isQualified, packageOf, qualify,
+    toPackage, toQualified,
 ) where
 import qualified Data.Map as Map
@@ -71 +73 @@
     doFindVarRef name = do
         callCC $ \foundIt -> do
-            lexSym <- fmap (findSym name . envLexical) ask
+            lexSym  <- fmap (findSym name . envLexical) ask
             when (isJust lexSym) $ foundIt lexSym
-            glob   <- liftSTM . readTVar . envGlobal =<< ask
-            let globSym = findSym name glob
+            glob    <- liftSTM . readTVar . envGlobal =<< ask
+            name'   <- toQualified name
+            -- XXX - find qualified name here
+            let globSym = findSym name' glob
             when (isJust globSym) $ foundIt globSym
             let globSym = findSym (toGlobal name) glob
@@ -398 +402 @@
     = Nothing
 
+breakSigil :: String -> (String, String)
+breakSigil = break (\x -> isAlpha x || x == '_')
+
 toPackage :: String -> String -> String
 toPackage pkg name
-    | (sigil, identifier) <- break (\x -> isAlpha x || x == '_') name
+    | (sigil, identifier) <- breakSigil name
     , last sigil /= '*'
     = concat [sigil, pkg, "::", identifier]
     | otherwise = name
 
+packageOf :: String -> String
+packageOf name = case isQualified name of
+    Just (pkg, _)   -> pkg
+    _               -> "main"
+
+qualify :: String -> String
+qualify name = case isQualified name of
+    Just _  -> name
+    _       -> let (sigil, name') = breakSigil name
+        in sigil ++ "main::" ++ name'
+
+isQualified :: String -> Maybe (String, String)
+isQualified name | Just (post, pre) <- breakOnGlue "::" (reverse name) =
+    let (sigil, pkg) = span (not . isAlphaNum) preName
+        name'       = possiblyFixOperatorName (sigil ++ postName)
+        preName     = reverse pre
+        postName    = reverse post
+    in Just (pkg, name')
+isQualified _ = Nothing
+
+toQualified :: String -> Eval String
+toQualified name@(_:'*':_) = return name
+toQualified name@(_:'?':_) = return name
+toQualified name@(_:"!") = return name
+toQualified name@(_:"/") = return name
+toQualified name = do
+    case isQualified name of
+        Just _  -> return name
+        _       -> do
+            pkg <- asks envPackage
+            return $ toPackage pkg name