Changeset 32

Show
Ignore:
Timestamp:
02/16/05 18:48:28 (4 years ago)
Author:
autrijus
svk:copy_cache_prev:
1041
Message:

* Code literals -- "sub", "pointy" and "bare" variants all works
* Lexical subroutine declarations via "my sub"
* Global subroutine and variables work again, via the envGlobal pad
* The "say", "exit", "die" primitives
* Bool.perl now prints correct literals (lwall)
* Blocks under void contexts now evaluates automatically
* The "..." (dotdotdot) literal

Files:
11 modified

Legend:

Unmodified
Added
Removed

  • AUTHORS

    r21 r32  
    66Bestian Tang 
    77Brian Ingerson          (INGY) 
     8Chia-Liang Kao          (CLKAO) 
    89Damian Conway           (DCONWAY) 
    910Hsin-Chan Chien         (HCCHIEN) 

  • Makefile.PL

    r9 r32  
    33use strict; 
    44use FindBin; 
     5use File::Spec; 
    56use Config; 
    67use inc::Module::Install; 
    78 
    89chdir $FindBin::Bin; 
     10my $pugs = File::Spec->catfile($FindBin::Bin, "pugs$Config{_exe}"); 
    911 
    1012name            ('Perl6-Pugs'); 
    … …  
    1315author          ('Autrijus Tang <autrijus@autrijus.org>'); 
    1416license         ('perl'); 
    15 install_script  ("pugs$Config{_exe}"); 
     17install_script  ($pugs); 
    1618build_requires  ('Test::More'); 
    1719 
    … …  
    6769 
    6870postamble(<< "."); 
    69 pugs$Config{_exe}: @{[glob("src/*.hs")]} 
    70         ghc --make -o pugs -O src/Main.hs -isrc 
     71$pugs: @{[glob("src/*.hs")]} 
     72        ghc --make -o pugs src/Main.hs -isrc 
    7173 
    7274tags :: 
    … …  
    7577 
    7678WriteAll( sign => 1 ); 
     79 
     80# FIXUP 
     81open MAKEFILE, '< Makefile' or die $!; 
     82my $makefile = do { local $/; <MAKEFILE> }; 
     83$makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/ENV->{HARNESS_PERL} = '$pugs'; $1/; 
     84close MAKEFILE; 
     85open MAKEFILE, '> Makefile' or die $!; 
     86print MAKEFILE $makefile; 
     87close MAKEFILE; 

  • src/AST.hs

    r31 r32  
    4646    castV = VSub 
    4747    doCast (VSub b) = b 
     48    doCast v = error ("Cannot cast into VSub: " ++ (show v)) 
    4849 
    4950instance Value VBool where 

  • src/Eval.hs

    r31 r32  
    2929    uniq <- liftIO $ newUnique 
    3030    return $ Env 
    31         { envContext = "List" 
     31        { envContext = "Void" 
    3232        , envLexical = [] 
    3333        , envGlobal  = initSyms 
    … …  
    5757evaluate :: Exp -> Eval Val 
    5858evaluate (Val (VSub sub)) = do 
    59     pad <- asks envLexical 
    60     return $ VSub sub{ subPad = pad } -- closure! 
     59    cxt <- asks envContext 
     60    if cxt == "Void" && subType sub == SubBlock 
     61        then do 
     62            exp <- apply sub [] [] 
     63            evalExp exp 
     64        else do 
     65            pad <- asks envLexical 
     66            return $ VSub sub{ subPad = pad } -- closure! 
    6167evaluate (Val val) = return val 
    6268evaluate exp = do 
    … …  
    149155        let [Sym (Symbol _ _ exp)] = exps 
    150156        val     <- evalExp exp 
    151         retVal val 
     157        retVal VUndef 
    152158    ":=" -> do 
    153159        let [Var var, exp] = exps 
    154         val     <- evalExp exp 
     160        val     <- enterEvalContext (cxtOfSigil $ head var) exp 
    155161        retVal val 
    156162    "::=" -> do -- XXX wrong 

  • src/Help.hs

    r7 r32  
    11{-# OPTIONS -cpp #-} 
    2 #define VERSION "" 
     2#define VERSION "6" 
    33#define DATE "" 
    44#include "config.h" 
    … …  
    1313-} 
    1414 
    15 module Help (printHelp, banner, version, copyright, disclaimer) where 
     15module Help (printHelp, banner, versnum, version, copyright, disclaimer) where 
    1616 
    1717printHelp :: IO () 

  • src/Internals.hs

    r29 r32  
    7878    show = show . hashUnique 
    7979instance Show (a -> b) where 
    80     show f = "sub { ... }" 
     80    show f = "(->)" 
    8181instance Eq (a -> b) where 
    8282    _ == _ = False 

  • src/Lexer.hs

    r31 r32  
    1818 
    1919perl6Def  = javaStyle 
    20           { P.commentStart   = "\n=begin\n" 
    21           , P.commentEnd     = "\n=cut\n" 
     20          { P.commentStart   = "=pod" 
     21          , P.commentEnd     = "=cut" 
    2222          , P.commentLine    = "#" 
    2323          , P.nestedComments = False 

  • src/Main.hs

    r31 r32  
    2525 
    2626main :: IO () 
    27 main = getArgs >>= run 
     27main = do 
     28    args <- getArgs 
     29    run $ concatMap procArg args 
     30    where 
     31    procArg ('-':'e':prog@(_:_)) = ["-e", prog] 
     32    procArg ('-':'d':rest@(_:_)) = ["-d", ('-':rest)] 
     33    procArg x = [x] 
    2834 
    2935run :: [String] -> IO () 
     36run ("-d":rest)                 = run rest 
     37run ("-w":rest)                 = run rest 
    3038run (('-':'e':prog@(_:_)):args) = doRun "-" args prog 
    3139run ("-e":prog:args)            = doRun "-" args prog 
    3240run ("-h":_)                    = printHelp 
     41run ("-":args)                  = do 
     42    prog <- getContents 
     43    doRun "-" [] prog 
    3344run (file:args)                 = readFile file >>= doRun file args 
    3445run []                          = do 
    … …  
    3748    if isTTY 
    3849        then banner >> repLoop 
    39         else do 
    40             prog <- getContents 
    41             doRun "-" [] prog 
     50        else run ["-"] 
    4251 
    4352repLoop :: IO () 
    … …  
    6170 
    6271doEval :: [String] -> String -> IO () 
    63 doEval = runProgramWith (putStrLn . pretty) "<interactive>" 
     72doEval = do 
     73    runProgramWith id (putStrLn . pretty) "<interactive>" 
    6474 
    6575doRun :: String -> [String] -> String -> IO () 
    66 doRun = runProgramWith (putStr . concatMap vCast . vCast) 
     76doRun = do 
     77    runProgramWith (\e -> e{ envDebug = Nothing }) end 
     78    where 
     79    end v@(VError str exp)  = do 
     80        hPutStrLn stderr str 
     81        exitFailure 
     82    end _               = return () 
    6783 
    68 runProgramWith :: (Val -> IO ()) -> String -> [String] -> String -> IO () 
    69 runProgramWith f name args prog = do 
     84runProgramWith :: (Env -> Env) -> (Val -> IO ()) -> VStr -> [VStr] -> String -> IO () 
     85runProgramWith fenv f name args prog = do 
    7086    env <- emptyEnv 
    71     let env' = runRule (prepare env) id ruleProgram prog 
     87    let env' = runRule (prepare $ fenv env) id ruleProgram prog 
    7288    val <- (`runReaderT` env') $ do 
    7389        (`runContT` return) $ do 
    … …  
    8096        ] ++ envGlobal e } 
    8197 
     98{- 
     99main = do 
     100    -- (optsIO, rest, errs) <- return . getOpt Permute options $ procArgs args 
     101 
     102options :: [OptDescr (Opts -> Opts)] 
     103options = 
     104    [ reqArg "e" ["eval"]           "command"       "Command-line program" 
     105        (\s o -> o { encodings          = split "," s }) 
     106    , noArg  "d" ["debug"]                          "Turn on debugging" 
     107        (\s o -> o { inputFile          = s }) 
     108    , noArg  "h" ["help"]                           "Show help" 
     109        (\o   -> o { showHelp           = usage "" }) 
     110    ] 
     111-} 
     112 

  • src/Parser.hs

    r31 r32  
    1313import Internals 
    1414import AST 
     15import Help 
    1516import Lexer 
    1617 
    … …  
    5657    , rulePackageDeclaration 
    5758    , ruleVarDeclaration 
     59    , ruleUseDeclaration 
    5860    ] 
    5961 
    … …  
    8789        , ruleSubGlobal 
    8890        ] 
    89     pos     <- getPosition 
    9091    cxt2    <- option cxt1 $ ruleBareTrait "returns" 
    9192    formal  <- option Nothing $ return . Just =<< parens ruleSubParameters 
    … …  
    148149    scope   <- ruleScope 
    149150    name    <- parseVarName 
    150     return $ Syn "sym" [Sym (Symbol scope name (Val VUndef))] 
     151    exp     <- option (Val VUndef) $ do 
     152        tryChoice $ map symbol $ words " = := ::= " 
     153        ruleExpression 
     154    return $ Syn "sym" [Sym $ Symbol scope name exp] 
     155 
     156ruleUseDeclaration :: RuleParser Exp 
     157ruleUseDeclaration = rule "use declaration" $ do 
     158    symbol "use" 
     159    option ' ' $ char 'v' 
     160    version <- many1 (choice [ digit, char '.' ]) 
     161    when (version > versnum) $ do 
     162        pos <- getPosition 
     163        error $ "Perl v" ++ version ++ " required--this is only v" ++ versnum ++ ", stopped at " ++ (show pos) 
     164    return $ Val VUndef 
    151165 
    152166rulePackageDeclaration = rule "package declaration" $ fail "" 
    … …  
    156170ruleConstruct = rule "construct" $ tryChoice 
    157171    [ ruleGatherConstruct 
    158     , ruleBlockConstruct 
    159172    ] 
    160173 
    … …  
    163176    block <- ruleBlock 
    164177    retSyn "gather" [block] 
    165  
    166 ruleBlockConstruct = rule "block construct" $ do 
    167     formal <- option Nothing $ choice [ ruleBlockFormalStandard, ruleBlockFormalPointy ] 
    168     block <- ruleBlock 
    169     fail "" 
    170  
    171 ruleBlockFormalStandard = rule "standard block parameters" $ do 
    172     symbol "sub" 
    173     return . Just =<< parens ruleSubParameters 
    174  
    175 ruleBlockFormalPointy = rule "pointy block parameters" $ do 
    176     symbol "->" 
    177     return . Just =<< ruleSubParameters 
    178178 
    179179ruleCondConstruct = rule "conditional construct" $ fail "" 
    … …  
    187187ruleExpression = (<?> "expression") $ parseOp 
    188188 
     189ruleBlockLiteral = rule "block construct" $ do 
     190    (typ, formal) <- option (SubBlock, Nothing) $ choice 
     191        [ ruleBlockFormalStandard 
     192        , ruleBlockFormalPointy 
     193        ] 
     194    body <- ruleBlock 
     195    let (fun, names) = extract (body, []) 
     196        params = (maybe [] id formal) ++ map nameToParam names 
     197    -- Check for placeholder vs formal parameters 
     198    unless (isNothing formal || null names || names == ["$_"] ) $ 
     199        fail "Cannot mix placeholder variables with formal parameters" 
     200    let sub = Sub { isMulti       = False 
     201                  , subName       = "<anon>" 
     202                  , subPad        = [] 
     203                  , subType       = typ 
     204                  , subAssoc      = "pre" 
     205                  , subReturns    = "Any" 
     206                  , subParams     = if null params then [defaultArrayParam] else params 
     207                  , subFun        = fun 
     208                  } 
     209    return (Val $ VSub sub) 
     210 
     211ruleBlockFormalStandard = rule "standard block parameters" $ do 
     212    symbol "sub" 
     213    params <- option Nothing $ return . Just =<< parens ruleSubParameters 
     214    return $ (SubRoutine, params) 
     215 
     216ruleBlockFormalPointy = rule "pointy block parameters" $ do 
     217    symbol "->" 
     218    params <- ruleSubParameters 
     219    return $ (SubBlock, Just params) 
     220 
    189221 
    190222 
    … …  
    211243    , postOps  " ++ -- "                                -- Auto-Increment 
    212244    , rightOps " ** "                                   -- Exponentiation 
    213     , preOps   " ! + - ~ ? * ** +^ ~^ ?^ \\ "           -- Symbolic Unary 
     245--  , preOps   " ! + - ~ ? * ** +^ ~^ ?^ \\ "           -- Symbolic Unary 
     246    , preOps   " ! + ~ ? * ** +^ ~^ ?^ \\ "             -- Symbolic Unary 
    214247    , leftOps  " * / % x xx +& +< +> ~& ~< ~> "         -- Multiplicative 
    215248    , leftOps  " + - ~ +| +^ ~| ~^ "                    -- Additive 
    … …  
    344377    sigil   <- oneOf "$@%&" 
    345378    caret   <- option "" $ choice [ string "^", string "*" ] 
    346     name    <- many1 wordAny 
    347     return $ (sigil:caret) ++ name 
     379    name    <- many1 (choice [ wordAny, char ':' ]) 
     380    return $ if sigil == '&' && not (':' `elem` name) 
     381        then (sigil:caret) ++ "prefix:" ++ name 
     382        else (sigil:caret) ++ name 
    348383 
    349384parseVar = do 
    … …  
    356391 
    357392parseLit = choice 
    358     [ numLiteral 
     393    [ ruleBlockLiteral 
     394    , numLiteral 
    359395    , strLiteral 
    360396    , arrayLiteral 

  • src/Prim.hs

    r31 r32  
    5858    liftIO . putStr . concatMap vCast . vCast $ v 
    5959    return $ VUndef 
     60op1 "say" = \v -> do 
     61    liftIO . putStrLn . concatMap vCast . vCast $ v 
     62    return $ VUndef 
     63op1 "die" = \v -> do 
     64    return $ VError (concatMap vCast . vCast $ v) (Val v) 
     65op1 "exit" = \v -> do 
     66    if vCast v 
     67        then liftIO $ exitWith (ExitFailure $ vCast v) 
     68        else liftIO $ exitWith ExitSuccess 
    6069 
    6170op1 s      = return . (\x -> VError ("unimplemented unaryOp: " ++ s) (Val x)) 
    … …  
    260269\\n   Num       pre     rand    (?Num=1)\ 
    261270\\n   Action    pre     print   (List)\ 
     271\\n   Action    pre     say     (List)\ 
     272\\n   Action    pre     die     (List)\ 
     273\\n   Any       pre     do      (Str)\ 
    262274\\n   Any       pre     return  (Any)\ 
    263275\\n   Junction  pre     any     (List)\ 

  • t/01basic.t

    r31 r32  
    1 #!/usr/bin/perl 
     1use v6; 
    22 
    3 use FindBin; 
    4 use Config; 
    5 use File::Spec; 
     3=pod 
    64 
    7 chdir (File::Spec->catdir($FindBin::Bin, File::Spec->updir)); 
    8 my $pugs = File::Spec->catfile(File::Spec->curdir, "pugs$Config{_exe}"); 
     5This is a test file.  Whee! 
    96 
    10 system($pugs, -e => '"1..2\nok 1 # Welcome to Pugs!\n"'); 
     7=cut 
    118 
    12 open PUGS, "| $pugs" or die "Cannot pipe out to $pugs: $!"; 
    13 print PUGS << '.'; 
    14     sub cool { fine($_) ~ " # We've got " ~ toys }; 
    15     sub fine { "ok " ~ $_ }; 
    16     sub toys { "fun and games!\n" }; 
    17     cool 2 
    18 . 
    19 close PUGS; 
     9say "1..2"; 
     10say "ok 1 # Welcome to Pugs!"; 
     11 
     12sub cool { fine($_) ~ " # We've got " ~ toys } 
     13sub fine { "ok " ~ $_ } 
     14sub toys { "fun and games!" } 
     15 
     16say cool 2 # and that's it, folks!