Changeset 16416

Timestamp:

05/18/07 00:17:23 (18 months ago)

Author:

audreyt

Message:

* Pugs.Parser: Each symbol is now exported exactly once -- the

old %EXPORT treatment of putting each multi variant into its
own array element is now replaced by simply exporting the
toplevel proto/multi sub.

Files:

• src/Pugs/Parser.hs (modified) (13 diffs)

src/Pugs/Parser.hs

@@ -389 +389 @@
             `finallyM` clearDynParsers
 
-    -- XXX - Generate init pad for each of our params...
-
+    -- Generate init pad for each of our params, as well as for ourselves...
     paramsPad   <- genParamEntries styp signature
     modify $ \s -> s{ s_protoPad = paramsPad }
@@ -409 +408 @@
                 , subOuterPads  = envLexPads env
                 , subInnerPad   = bi_pad block
+                , subTraitBlocks= bi_traits block (subTraitBlocks template)
                 }
-        sub = VCode (bi_traits block template')
+        sub = VCode template'
     
     -- Don't add the sub if it's unsafe and we're in safemode.
@@ -436 +436 @@
                                 , subParams = multiSig
                                 }
-                    unsafeEvalExp $ Syn "|="
+                    unsafeEvalExp $ Syn "="
                         [ Syn "{}" [_Var ("%" ++ pkg ++ "::EXPORTS"), Val $ VStr exportedName]
                         , Val exportedSub
@@ -937 +937 @@
         fail "Closure traits take no formal parameters"
     env <- ask
-    let code = VCode mkSub
+    let code = mkSub
             { subName       = cast name
-            , subType       = SubRoutine -- XXX - This should be SubBlock - See Pugs.Monads.enterSub for "displaced" subs
+            , subType       = SubBlock
             , subBody       = fun
+            , subPackage    = envPackage env
             , subInnerPad   = (bi_pad block)
             , subOuterPads  = (PCompiling (fromJust $ envCompPad env):envLexPads env)
@@ -1011 +1012 @@
 possiblyExit x = return x
 
-vcode2startBlock :: Val -> RuleParser Exp
-vcode2startBlock (VCode code) = do
+vcode2memoized :: VCode -> RuleParser VCode
+vcode2memoized code = do
     -- Ok. Now the tricky thing.
     -- This is the general idea:
@@ -1029 +1030 @@
         (_Sym SState "$?START_RUN" mempty emptyExp) $ emptyExp
 
-    let code' = code{ subBody = body', subInnerPad = subInnerPad code `mappend` lexDiff }
-        body' = Syn "if"
+    let body' = Syn "if"
                     [ App (_Var "&postfix:++") Nothing [_Var "$?START_RUN"]
                     , _Var "$?START_RESULT"
@@ -1036 +1036 @@
                     ]   --  { $?START_RUN++; $?START_RESULT = 42 };
 
+    return $ code
+        { subBody     = body'
+        , subInnerPad = subInnerPad code `mappend` lexDiff
+        }
+
+vcode2startBlock :: Val -> RuleParser Exp
+vcode2startBlock ~(VCode code) = do
+    code'   <- vcode2memoized code
     return $ App (Syn "sub" [Val (VCode code')]) Nothing []
-vcode2startBlock _ = fail "impossible"
 
 vcode2initBlock :: Val -> RuleParser Exp
@@ -1047 +1054 @@
 
 vcode2checkBlock :: Val -> RuleParser Exp
-vcode2checkBlock code = do
-    body    <- vcode2startBlock code
-    let fstcode = Syn "sub" [ checkForIOLeak mkSub{ subBody = body } ]
+vcode2checkBlock ~(VCode code) = do
+    code'   <- vcode2memoized code
     Val res <- unsafeEvalExp $
         App (_Var "&unshift") (Just $ _Var "@*CHECK") [ Val (VCode code') ]
@@ -1287 +1293 @@
         fail "Cannot mix placeholder variables with formal parameters"
     env <- ask
-    let sub = bi_traits block $ mkCode
+    let sub = mkCode
             { isMulti       = False
             , subName       = __"<anon>"
@@ -1326 +1332 @@
     return $ (SubPointy, params, "rw" `elem` traits)
 
+genNameTypeEntries :: Scope -> [(String, VType, EntryFlags, Exp)] -> RuleParser Pad
 genNameTypeEntries scope nameTypes = do
     unsafeEvalLexDiff $ combine (map makeBinding nameTypes) emptyExp
@@ -1338 +1345 @@
         bindSym     = Stmts (Syn "=" [_Var name, Val (VType typ)])
 
+paramsToNameTypes :: [Param] -> String -> [(String, Type, EntryFlags, Exp)]
 paramsToNameTypes params defType = [ (n, t, f, d) | n <- names | t <- types | f <- flags | d <- defs ]
     where
@@ -1349 +1357 @@
         | otherwise                     = t
 
-genParamEntries styp params
-    | styp >= SubBlock  = genNameTypeEntries SMy nameTypes
-    | otherwise         = genNameTypeEntries SMy (foldl' withImplicit nameTypes implicitNames)
+genParamEntries :: SubType -> Params -> RuleParser Pad
+genParamEntries styp params = genNameTypeEntries SMy (foldl' withImplicit nameTypes implicitNames)
     where
-    nameTypes       = paramsToNameTypes params ""
+    params'
+        | SubMethod <- styp = (defaultSelfParam:params)
+        | otherwise         = params
+    nameTypes       = paramsToNameTypes params' ""
     names           = Set.fromList $ map (\(n, _, _, _) -> n) nameTypes
-    implicitNames   = ["$_"] -- , "$/", "$!"]
+    implicitNames   = case styp of
+        SubPrim     -> []
+        SubPointy   -> ["&?BLOCK"] -- , "$/", "$!"]
+        SubBlock    -> ["$_", "&?BLOCK"] -- , "$/", "$!"]
+        _           -> ["$_", "&?BLOCK", "&?ROUTINE"] -- , "$/", "$!"]
     withImplicit ntys name
         | Set.member (cast name) names  = ntys
         | otherwise                     = (((cast name), anyType, MkEntryFlags True, Noop):ntys)
+    defaultSelfParam = buildParam "" "" "$__SELF__" (Val VUndef)
 
 ruleVarDecl :: RuleParser Exp
@@ -2063 +2078 @@
         _ -> do
             -- Plain and simple variable -- do a lexical check
-            -- Algorithm: Navigate outerward to find the first one defined;
-            --            record the 
+            -- First check if it's "known".
+            --   If it is, then simply makeVar.
+            --   If it is not, then it's "free"; add it to the list of freeVars
+            --   for the final check.
+
             state <- get