Changeset 5169

Timestamp:

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

Author:

autrijus

svk:copy_cache_prev:

6965

Message:

* our variables in packages now generate qualified symbols.

Location:

src/Pugs

Files:

• AST.hs (modified) (1 diff)
• Eval.hs (modified) (6 diffs)
• Parser.hs (modified) (3 diffs)
• Parser/Program.hs (modified) (2 diffs)

src/Pugs/AST.hs

@@ -124 +124 @@
 mergeStmts (Sym scope name x) y = Sym scope name (mergeStmts x y)
 mergeStmts (Pad scope lex x) y = Pad scope lex (mergeStmts x y)
+mergeStmts (Syn "package" [pkg@(Val (VStr _))]) y =
+    Syn "namespace" [pkg, y]
 mergeStmts x@(Pos pos (Syn syn _)) y | (syn ==) `any` words "subst match //"  =
     mergeStmts (Pos pos (App (Var "&infix:~~") Nothing [Var "$_", x])) y

src/Pugs/Eval.hs

@@ -105 +105 @@
 evaluateMain exp = do
     -- S04: INIT {...}*      at run time, ASAP
-    initAV   <- evalVar "@?INIT"
+    initAV   <- evalVar "@*INIT"
     initSubs <- fromVals initAV
     enterContext CxtVoid $ do
@@ -246 +246 @@
     case v of
         Just var -> evalRef var
-        _ | (':':rest) <- name -> return $ VType (mkType rest)
-        _ -> retError "Undeclared variable" name
+        _ -> case name of
+            (':':rest)  -> return $ VType (mkType rest)
+            (_:'*':_)   -> evalExp (Sym SGlobal name (Var name))
+            _           -> case isQualified name of
+                Just _  -> evalExp (Sym SGlobal name (Var name))
+                _       -> retError "Undeclared variable" name
 
 reduceStmts :: Exp -> Exp -> Eval Val
@@ -303 +307 @@
 
 reduceSym _ name exp = do
-    ref <- newObject (typeOfSigil $ head name)
-    sym <- case name of
-        ('&':_) -> genMultiSym name ref
-        _       -> genSym name ref
+    ref     <- newObject (typeOfSigil $ head name)
+    name'   <- toQualified name
+    sym <- case name' of
+        ('&':_) -> genMultiSym name' ref
+        _       -> genSym name' ref
     addGlobalSym sym
     evalExp exp
@@ -648 +653 @@
     retEmpty
 
-reduceSyn "package" [exp] = do
+reduceSyn "namespace" [exp, body] = do
     val <- evalExp exp
     writeVar "$*PACKAGE" val
-    retEmpty
-
-reduceSyn "module" [exp] = do
-    val <- evalExp exp
-    writeVar "$?MODULE" val
-    writeVar "$*PACKAGE" val
-    retEmpty
+    str <- fromVal val
+    enterPackage str $ evalExp body
 
 reduceSyn "inline" [langExp, _] = do
@@ -664 +664 @@
     when (lang /= "Haskell") $
         retError "Inline: Unknown language" langVal
-    modVal  <- readVar "$?MODULE"
+    modVal  <- readVar "$*PACKAGE"
     mod     <- fromVal modVal
 #ifndef HADDOCK
@@ -985 +985 @@
                         "Hash"  -> fmap (VRef . hashRef) (fromVal v :: Eval VHash)
                         "Array" -> fmap (VRef . arrayRef) (fromVal v :: Eval VArray)
-                        _       -> return (VRef $ scalarRef v) 
+                        _       -> case v of
+                            VRef (MkRef (IScalar _)) -> return (VRef $ scalarRef v) 
+                            VRef _ -> return v -- XXX - preserving ref
+                            _ -> return (VRef $ scalarRef v) 
                 (False, False)  -> return v -- XXX reduce to val?
                 (False, True)   -> do

src/Pugs/Parser.hs

@@ -296 +296 @@
     let subExp = Val . VCode $ MkCode
             { isMulti       = isMulti
-            , subName       = name'
+            , subName       = nameQualified
             , subEnv        = Just env
             , subType       = if "primitive" `elem` traits
@@ -311 +311 @@
             }
         pkg = envPackage env
-        name' | ':' `elem` name = name
-              | scope <= SMy    = name
-              | otherwise       = (head name:pkg) ++ "::" ++ tail name
+        nameQualified | ':' `elem` name = name
+                      | scope <= SMy    = name
+                      | isBuiltin       = (head name:'*':tail name)
+                      | otherwise       = (head name:pkg) ++ "::" ++ tail name
         self :: [Param]
         self | styp > SubMethod = []
              | (prm:_) <- params, isInvocant prm = []
              | otherwise = [selfParam $ envPackage env]
-        exp  = Syn ":=" [Var name, Syn "sub" [subExp]]
-        exp' = Syn ":=" [Var name', Syn "sub" [subExp]]
-        isExported = (pkg == "main" || "export" `elem` traits)
+        mkExp n = Syn ":=" [Var n, Syn "sub" [subExp]]
+        mkSym n = Sym scope n (mkExp n)
+        isExported = ("export" `elem` traits)
+        isBuiltin = ("builtin" `elem` traits)
     -- Don't add the sub if it's unsafe and we're in safemode.
-    if "unsafe" `elem` traits && safeMode
-        then return emptyExp
-        else case scope of
-            -- XXX FIXME - the "main" here is a horrible hack
-            SGlobal | name' /= name && isExported -> do
-                unsafeEvalExp (Sym scope name exp)
-                unsafeEvalExp (Sym scope name' exp')
-                return emptyExp
-            SGlobal -> do
-                unsafeEvalExp (Sym scope name' exp')
-                return emptyExp
-            _ -> do
-                lexDiff <- unsafeEvalLexDiff (Sym scope name' emptyExp)
-                return $ Pad scope lexDiff exp
+    if "unsafe" `elem` traits && safeMode then return emptyExp else case scope of
+        SGlobal | isExported -> do
+            let caller  = maybe "main" envPackage (envCaller env)
+                nameExported = (head name:caller) ++ "::" ++ tail name
+            unsafeEvalExp $ mkSym nameExported
+            unsafeEvalExp $ mkSym nameQualified
+            return emptyExp
+        SGlobal -> do
+            unsafeEvalExp $ mkSym nameQualified
+            return emptyExp
+        _ -> do
+            lexDiff <- unsafeEvalLexDiff $ mkSym nameQualified
+            return $ Pad scope lexDiff $ mkExp name
 
 -- | A Param representing the default (unnamed) invocant of a method on the given type.
@@ -574 +575 @@
 ruleModuleDeclaration = rule "module declaration" $ do
     _       <- choice $ map symbol (words "package module class grammar")
-    (name, v, a)    <- rulePackageHead
+    (name, _, _)    <- rulePackageHead
     env     <- getRuleEnv
     putRuleEnv env{ envPackage = name, envClasses = envClasses env `addNode` mkType name }
     body    <- option emptyExp $ between (symbol "{") (char '}') ruleBlockBody
-    let moduleDef = Syn "module" [Val . VStr $ name ++ v ++ a] -- XXX
+    let pkgVal = Val . VStr $ name -- ++ v ++ a
     case body of
-        Noop -> return moduleDef
+        Noop -> return $ Syn "package" [pkgVal]
         _    -> do
             env' <- getRuleEnv
             putRuleEnv env'{ envPackage = envPackage env }
-            return $ Stmts moduleDef body
+            return $ Syn "namespace" [pkgVal, body]
 
 ruleDoBlock :: RuleParser Exp

src/Pugs/Parser/Program.hs

@@ -43 +43 @@
     eof
     -- S04: CHECK {...}*      at compile time, ALAP
-    --  $_() for @?CHECK
+    --  $_() for @*CHECK
     rv <- unsafeEvalExp $ Syn "for"
-        [ Var "@?CHECK"
+        [ Var "@*CHECK"
         , Syn "sub"
             [ Val . VCode $ mkSub
@@ -53 +53 @@
             ]
         ]
-    -- If there was a exit() in a CHECK block, we've to exit.
+    -- If there was a exit() in a CHECK block, we have to exit.
     possiblyExit rv
     env' <- getRuleEnv