Changeset 10645

Show
Ignore:
Timestamp:
06/12/06 11:51:43 (2 years ago)
Author:
audreyt
Message:

* Pugs is now capable of doing parse-time analysis on

unbound lexical variables:

$ ./pugs -c -e '$x'
*** unexpected global symbol "$x" requires explicit package name

expecting "::"
at -e line 1, column 3

* Also, named subroutines are now expressions instead of statements:

# This is valid Perl 6
my @subs = (sub f { 1 }, sub g { 2 });

consequently, all unqualified symbol lookup (&f and &g above) are
now lexical instead of dynamic.

* Private subroutines are now exportable:

module Foo;
my sub bar is export { ... }

this allows import from Foo but disallows &Foo::bar.

Location:
src
Files:
7 modified

Legend:

Unmodified
Added
Removed

  • src/Pugs.hs

    r10461 r10645  
    353353        Val err@(VError (VStr msg) _) 
    354354            | runOptShowPretty opts 
    355             , any (== "unexpected end of input") (lines msg) -> do 
     355            , any (== "unexpected end of input") (lines msg) 
     356            , not (any ("unexpected global symbol " `isPrefixOf`) (lines msg)) -> do 
    356357            cont <- readline "....> " 
    357358            case cont of 

  • src/Pugs/AST/Internals/Instances.hs

    r10528 r10645  
    570570        "SMy" -> do 
    571571            return SMy 
     572        "SParam" -> do 
     573            return SParam 
    572574        "SOur" -> do 
    573575            return SOur 
    574576        "SGlobal" -> do 
    575577            return SGlobal 
    576         _ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["SState","SLet","STemp","SEnv","SMy","SOur","SGlobal"] ++ " in node " ++ show e 
     578        _ -> fail $ "unhandled tag: " ++ show t ++ ", expecting " ++ show ["SState","SLet","STemp","SEnv","SMy","SParam","SOur","SGlobal"] ++ " in node " ++ show e 
    577579    fromYAML _ = fail "no tag found" 
    578580    asYAML (SState) = asYAMLcls "SState" 
    … …  
    581583    asYAML (SEnv) = asYAMLcls "SEnv" 
    582584    asYAML (SMy) = asYAMLcls "SMy" 
     585    asYAML (SParam) = asYAMLcls "SParam" 
    583586    asYAML (SOur) = asYAMLcls "SOur" 
    584587    asYAML (SGlobal) = asYAMLcls "SGlobal" 
    … …  
    590593    showJSON (SEnv) = showJSScalar "SEnv" 
    591594    showJSON (SMy) = showJSScalar "SMy" 
     595    showJSON (SParam) = showJSScalar "SParam" 
    592596    showJSON (SOur) = showJSScalar "SOur" 
    593597    showJSON (SGlobal) = showJSScalar "SGlobal" 
    … …  
    599603    showPerl5 (SEnv) = showP5Class "SEnv" 
    600604    showPerl5 (SMy) = showP5Class "SMy" 
     605    showPerl5 (SParam) = showP5Class "SParam" 
    601606    showPerl5 (SOur) = showP5Class "SOur" 
    602607    showPerl5 (SGlobal) = showP5Class "SGlobal" 

  • src/Pugs/AST/Scope.hs

    r8694 r10645  
    1212           | SEnv    -- ^ Environment (declared with @env@) 
    1313           | SMy     -- ^ Lexical 
     14           | SParam  -- ^ Parameter 
    1415           | SOur    -- ^ Package 
    1516           | SGlobal -- ^ Global 

  • src/Pugs/Eval.hs

    r10619 r10645  
    307307 
    308308reducePad :: Scope -> Pad -> Exp -> Eval Val 
     309reducePad SParam _ exp = evalExp exp 
    309310reducePad SEnv lex@(MkPad lex') exp = do 
    310311    local (\e -> e{ envImplicit = Map.map (const ()) lex' `Map.union` envImplicit e }) $ 
    … …  
    344345-- Special case: my (undef) is no-op 
    345346reduceSym _ "" exp = evalExp exp 
     347 
     348reduceSym SParam name exp = do 
     349    let sym (MkPad map) = MkPad $ Map.insert name (MkEntryMulti []) map 
     350    enterLex [sym] $ evalExp exp 
    346351 
    347352reduceSym scope name exp | scope <= SMy = do 

  • src/Pugs/Internals.hs

    r10532 r10645  
    6767    inlinePerformIO, 
    6868    inlinePerformSTM, 
     69    unsafePerformSTM, 
    6970    possiblyFixOperatorName, 
    7071    maybeM, 
    … …  
    245246inlinePerformSTM m = inlinePerformIO (atomically m) 
    246247 
     248{-# NOINLINE unsafePerformSTM #-} 
     249unsafePerformSTM :: STM a -> a 
     250unsafePerformSTM m = unsafePerformIO (atomically m) 
     251 
    247252{-| 
    248253Read an STM variable, apply some transformation function to it, and write the 

  • src/Pugs/Parser.hs

    r10638 r10645  
    4040 
    4141ruleBlock :: RuleParser Exp 
    42 ruleBlock = do 
     42ruleBlock = ruleBlockWithParams [] 
     43 
     44ruleBlockWithParams :: [Param] -> RuleParser Exp 
     45ruleBlockWithParams params = do 
    4346    lvl <- gets ruleBracketLevel 
    4447    case lvl of 
    45         StatementBracket    -> ruleBlock' 
    46         _                   -> lexeme ruleVerbatimBlock 
     48        StatementBracket    -> ruleStatementBlock 
     49        _                   -> lexeme (ruleVerbatimBlockWithParams params) 
    4750    where 
    48     ruleBlock' = do 
    49         rv <- ruleVerbatimBlock 
     51    ruleStatementBlock = do 
     52        rv <- ruleVerbatimBlockWithParams params 
    5053        -- Implementation of 'line-ending } terminates statement' 
    5154        -- See L<S04/Statement-ending blocks>. 
    … …  
    6265 
    6366ruleVerbatimBlock :: RuleParser Exp 
    64 ruleVerbatimBlock = verbatimRule "block" $ do 
    65     body <- verbatimBraces ruleBlockBody 
     67ruleVerbatimBlock = ruleVerbatimBlockWithParams [] 
     68 
     69ruleVerbatimBlockWithParams :: [Param] -> RuleParser Exp 
     70ruleVerbatimBlockWithParams params = verbatimRule "block" $ do 
     71    body <- verbatimBraces (ruleBlockBodyWithParams params) 
    6672    return $ Syn "block" [body] 
    6773 
    … …  
    7278 
    7379ruleBlockBody :: RuleParser Exp 
    74 ruleBlockBody = 
    75   localEnv $ do 
     80ruleBlockBody = ruleBlockBodyWithParams [] 
     81 
     82ruleBlockBodyWithParams :: [Param] -> RuleParser Exp 
     83ruleBlockBodyWithParams params = localEnv $ do 
     84    unless (null params) $ do 
     85        lexDiff <- unsafeEvalLexDiff $ 
     86            combine [Sym SParam (paramName p) | p <- params ] emptyExp 
     87        addBlockPad SParam lexDiff 
    7688    whiteSpace 
    7789    pre     <- many ruleEmptyExp 
    … …  
    120132    sepLoop rule = do 
    121133        whiteSpace 
    122         (eof >> return Noop) <|> do 
     134        (eof >> return emptyExp) <|> do 
    123135            (exp, terminate) <- rule 
    124136            if terminate then return exp else do 
    125             rest <- option Noop (sepLoop rule) 
     137            rest <- option emptyExp (sepLoop rule) 
    126138            return $ exp `mergeStmts` rest 
    127139 
    … …  
    130142ruleBlockDeclaration :: RuleParser Exp 
    131143ruleBlockDeclaration = rule "block declaration" $ choice 
    132     [ ruleSubDeclaration 
    133     , ruleClosureTrait False 
     144    [ ruleClosureTrait False 
    134145    , ruleRuleDeclaration 
    135146    , rulePackageBlockDeclaration 
    … …  
    281292 
    282293    -- bodyPos <- getPosition 
    283     body    <- ruleBlock 
     294    body    <- ruleBlockWithParams (maybe [] id formal) 
    284295    let (fun, names, params) = doExtract styp formal body 
    285296    -- Check for placeholder vs formal parameters 
    … …  
    314325        mkExp n = Syn ":=" [Var n, Syn "sub" [Val sub]] 
    315326        mkSym n = Sym scope (mkMulti n) (mkExp n) 
     327        mkSymGlobal globalName lexicalName = Stmts 
     328            (Sym SMy (mkMulti lexicalName) (mkExp lexicalName)) 
     329            (Sym SGlobal (mkMulti globalName) (Syn ":=" [Var globalName, Var lexicalName])) 
    316330        -- Horrible hack! Sym "&&" is the multi form. 
    317331        mkMulti | isMulti   = ('&':) 
    … …  
    320334        isBuiltin = ("builtin" `elem` traits) 
    321335        isExported = ("export" `elem` traits) 
     336        isScopeGlobal = case scope of 
     337            SGlobal -> True 
     338            SOur    -> True 
     339            _       -> False 
     340        expMakeSym 
     341            | isScopeGlobal = mkSymGlobal nameQualified name 
     342            | otherwise     = mkSym nameQualified 
     343        expImmediate 
     344            | isExported    = Stmts expMakeSym $  
     345                (App (Var "&push") 
     346                    (Just (Syn "{}" [Var ("%" ++ pkg ++ "::EXPORTS"), Val $ VStr name])) 
     347                    [Var name]) 
     348            | otherwise     = expMakeSym 
    322349         
    323350    -- XXX this belongs in semantic analysis, not in the parser 
    … …  
    334361    -- Don't add the sub if it's unsafe and we're in safemode. 
    335362    if "unsafe" `elem` traits && safeMode then return emptyExp else do 
    336     rv <- case scope of 
    337         SGlobal | isExported -> do 
    338             -- we mustn't perform the export immediately upon parse, because 
    339             -- then only the first consumer of a module will see it. Instead, 
    340             -- make a note of this symbol being exportable, and defer the 
    341             -- actual symbol table manipulation to opEval. 
    342             unsafeEvalExp $ mkSym nameQualified 
    343             -- push %*INC<This::Package><exports><&this_sub>, expression-binding-&this_sub 
    344             --    ==> 
    345             -- push %This::Package::EXPORTS<&this_sub>, expression-binding-&this_sub 
    346             -- (a singleton list for subs, a full list of subs for multis) 
    347             return $ 
    348                 App (Var "&push") 
    349                     (Just (Syn "{}" [Var ("%" ++ pkg ++ "::EXPORTS"), Val $ VStr name])) 
    350                     [Val sub] 
    351         SGlobal -> do 
    352             unsafeEvalExp $ mkSym nameQualified 
    353             return emptyExp 
    354         _ -> do 
    355             lexDiff <- unsafeEvalLexDiff $ mkSym nameQualified 
    356             addBlockPad scope lexDiff 
    357             return $ mkExp name 
     363    lexDiff <- unsafeEvalLexDiff expImmediate 
     364    addBlockPad SMy lexDiff 
    358365    clearDynParsers 
    359     return rv 
    360  
     366    return (Var name) 
    361367 
    362368ruleSubNamePossiblyWithTwigil :: RuleParser String 
    … …  
    421427    let sigil'   = (if isOptional then '?' else '!'):sigil1 
    422428    exp <- case opt of 
    423         FormalsSimple -> return Noop 
     429        FormalsSimple -> return emptyExp 
    424430        FormalsComplex -> do 
    425431            rv <- ruleParamDefault (not isOptional) 
    … …  
    427433                symbol "-->" 
    428434                ruleParamList ParensOptional $ choice 
    429                     [ ruleType 
    430                     , ruleFormalParam FormalsComplex >> return "" 
     435                    [ ruleType >> return () 
     436                    , ruleFormalParam FormalsComplex >> return () 
    431437                    ] 
    432438            return rv 
    … …  
    439445 
    440446ruleParamDefault :: Bool -> RuleParser Exp 
    441 ruleParamDefault True  = return Noop 
    442 ruleParamDefault False = rule "default value" $ option Noop $ do 
     447ruleParamDefault True  = return emptyExp 
     448ruleParamDefault False = rule "default value" $ option emptyExp $ do 
    443449    symbol "=" 
    444450    parseExpWithItemOps 
    … …  
    911917                    (Just (Var end)) 
    912918                    [Val code] 
    913             return Noop 
     919            return emptyExp 
    914920        "BEGIN" -> do 
    915921            -- We've to exit if the user has written code like BEGIN { exit }. 
    … …  
    917923            -- And install any pragmas they've requested. 
    918924            env <- ask 
    919             let idat = inlinePerformSTM . readTVar $ envInitDat env 
     925            let idat = unsafePerformSTM . readTVar $ envInitDat env 
    920926            install $ initPragmas idat 
    921927            clearDynParsers 
    … …  
    960966        ] 
    961967    -- ...and then exit. 
    962     return $ inlinePerformIO $ exitWith exit 
     968    return $ unsafePerformIO $ exitWith exit 
    963969possiblyExit x = return x 
    964970 
    … …  
    11761182    (typ, formal, lvalue) <- option (SubBlock, Nothing, False) 
    11771183        $ choice variants 
    1178     body <- ruleBlock 
     1184    body    <- ruleBlockWithParams (maybe [] id formal) 
    11791185    retBlock typ formal lvalue body 
    11801186 
    … …  
    12791285    return exp 
    12801286    where 
    1281     deSigil (sig:'!':rest) = (sig:rest) 
     1287    deSigil (sig:'!':rest@(_:_)) = (sig:rest) 
    12821288    deSigil (sig:'.':rest) = (sig:rest) 
    12831289    deSigil x              = x 
    … …  
    12961302parseTerm = rule "term" $ do 
    12971303    term <- choice 
    1298         [ ruleDereference 
     1304        [ ruleSubDeclaration 
     1305        , ruleDereference 
    12991306        , ruleVarDecl 
    13001307        , ruleVar 
    … …  
    16521659        then ruleSubNamePossiblyWithTwigil 
    16531660        else do twigil <- ruleTwigil 
    1654                 name   <- many1 wordAny 
     1661                name   <- case twigil of 
     1662                    ""  -> many1 wordAny <|> string "/" 
     1663                    "!" -> many wordAny 
     1664                    _   -> many1 wordAny 
    16551665                return $ sigil ++ twigil ++ name 
    16561666 
    … …  
    16821692 
    16831693ruleSigiledVar :: RuleParser Exp 
    1684 ruleSigiledVar = (<|> ruleSymbolicDeref) . try $ do 
     1694ruleSigiledVar = (<|> ruleSymbolicDeref) $ do 
    16851695    name <- ruleVarNameString 
    1686     let (sigil, rest) = break isWordAny name 
     1696    let (sigil, rest) = span (`elem` "$@%&:^") name 
    16871697    case rest of 
    16881698        [] -> return (makeVar name) 
    16891699        _ | any (not . isWordAny) rest -> return (makeVar name) 
     1700        _ | all isDigit rest -> return (makeVar name) 
     1701        "_" -> return (makeVar name) 
    16901702        _ -> do 
    16911703            -- Plain and simple variable -- do a lexical check 
    … …  
    16981710            -- If it's visible in the total lexical scope, yet not 
    16991711            -- defined in the current scope, then generate OUTER. 
    1700             if lexVisible && not curVisible && not inTopLevel 
    1701                 then return (Var $ sigil ++ "OUTER::" ++ rest) 
    1702                 else return (makeVar name) 
     1712            case (lexVisible, curVisible) of 
     1713                (True, False) | not inTopLevel 
     1714                    -> return (Var $ sigil ++ "OUTER::" ++ rest) 
     1715                (False, False) 
     1716                    -> unexpected $ 
     1717                            "global symbol \"" ++ name 
     1718                            ++ "\" requires explicit package name" 
     1719                _   -> return (makeVar name) 
    17031720 
    17041721ruleVar :: RuleParser Exp 

  • src/Pugs/Parser/Export.hs

    r10634 r10645  
    2929                doExport scope mkSym 
    3030            case scope of 
    31                 SMy -> addBlockPad SState  
     31                SMy -> addBlockPad SState 
    3232                    (foldl unionPads (mkPad []) [ pad | Pad SMy pad _ <- exps ]) 
    3333                _   -> return ()