Pugs 6.2.13.20120203 → 6.2.13.20120717
raw patch · 13 files changed
+110/−66 lines, 13 filesdep ~HsParrotdep ~haskelinedep ~mtl
Dependency ranges changed: HsParrot, haskeline, mtl, pugs-DrIFT, pugs-compat
Files
- Pugs.cabal +10/−10
- src/Pugs/AST/Internals.hs +1/−1
- src/Pugs/AST/SIO.hs +3/−1
- src/Pugs/Cont.hs +1/−8
- src/Pugs/Eval/Var.hs +2/−2
- src/Pugs/Lexer.hs +18/−11
- src/Pugs/Parser.hs +4/−4
- src/Pugs/Prim.hs +58/−17
- src/Pugs/Prim/Eval.hs +4/−3
- src/Pugs/Prim/Yaml.hs +3/−3
- src/Pugs/Types.hs +2/−2
- src/Pugs/Val.hs +1/−1
- src/Pugs/Version.hs +3/−3
Pugs.cabal view
@@ -1,5 +1,5 @@ Name : Pugs-Version : 6.2.13.20120203+Version : 6.2.13.20120717 license : BSD3 license-file : LICENSE cabal-version : >= 1.2.3@@ -161,15 +161,15 @@ extra-lib-dirs: /usr/lib /opt/local/lib build-depends:- base >= 4 && < 5, filepath, mtl < 2.0.0.0, parsec >= 3.0.0.0, network,+ base >= 4 && < 5, filepath, mtl >= 2.0.0.0, parsec >= 3.0.0.0, network, pretty, time, random, process, containers, bytestring,- array, directory, utf8-string, binary, haskeline >= 0.6.4.0, FindBin,+ array, directory, utf8-string, binary, haskeline >= 0.6.4.7, FindBin, control-timeout >= 0.1.2, MetaObject >= 0.0.4,- HsParrot >= 0.0.2,- pugs-compat >= 0.0.5,- pugs-DrIFT >= 2.2.3.2,+ HsParrot >= 0.0.2.20120717,+ pugs-compat >= 0.0.6.20120717.204800,+ pugs-DrIFT >= 2.2.3.20120717, stringtable-atom >= 0.0.4, HsSyck >= 0.44, stm >= 2.1.2.1@@ -177,10 +177,10 @@ if flag(Perl5) cpp-options: -DPUGS_HAVE_PERL5=1+ includes:+ perl5/p5embed.h+ c-sources:+ cbits/Prelude_pm.c cbits/Test_pm.c perl5/p5embed.c c-sources: cbits/Prelude_pm.c cbits/Test_pm.c- perl5/p5embed.c-- includes:- perl5/p5embed.h
src/Pugs/AST/Internals.hs view
@@ -489,7 +489,7 @@ valType (VMatch _) = mkType "Match" valType (VType t) = t valType (VObject o) = objType o-valType (VOpaque _) = mkType "Object"+valType (VOpaque _) = mkType "Mu" valType (PerlSV _) = mkType "Scalar::Perl5" valType (VV _) = mkType "Scalar::Perl5" -- (cast $ Val.valMeta v)
src/Pugs/AST/SIO.hs view
@@ -10,7 +10,9 @@ module Control.Concurrent.STM ) where import Pugs.Internals-import Control.Concurrent.STM+import Control.Concurrent.STM (STM, atomically, TVar,+ writeTVar, readTVar, newTVarIO, newTVar, readTMVar, newTMVarIO,+ tryPutTMVar, takeTMVar, newEmptyTMVar) instance Monad m => ((:>:) (m a)) (Identity a) where cast = return . runIdentity instance ((:>:) (SIO a)) (STM a) where cast = liftSTM
src/Pugs/Cont.hs view
@@ -10,7 +10,7 @@ -} module Pugs.Cont (- callCCT, shift, reset, shiftT, resetT,+ callCCT, shiftT, resetT, module Control.Monad.Cont, ) where @@ -30,13 +30,6 @@ -- ghc doesn't allow something like m (forall c. m c) newtype EmptyMonad m = EmptyMonad { runEmptyMonad :: forall c. m c }---- shift/reset for the Cont monad-shift :: ((a -> Cont s r) -> Cont r r) -> Cont r a-shift e = Cont $ \k -> e (return . k) `runCont` id--reset :: Cont a a -> Cont r a -reset e = return $ e `runCont` id -- shiftT/resetT for the ContT monad transformer shiftT :: Monad m => ((a -> ContT r m s) -> ContT s m s) -> ContT s m a
src/Pugs/Eval/Var.hs view
@@ -223,7 +223,7 @@ -- has been reduced.) return . Just $ mkPrim { subName = methName- , subParams = makeParams ["Object", "List", "Named"]+ , subParams = makeParams ["Mu", "List", "Named"] , subReturns = mkType "Any" , subBody = Prim $ \(inv:named:pos:_) -> do invVV <- fromVal inv :: Eval Val.Val@@ -263,7 +263,7 @@ attrs <- fmap (fmap (filter (/= pkg) . nub)) $ findAttrs pkg if isNothing attrs || null (fromJust attrs) then fmap (err NoMatchingMulti) (findSub' var) else do -- XXX - "reverse" below is a crude hack before we have C3 dispatch;- -- - this is such that "class X is Object is Moose" can dispatch with Moose first.+ -- - this is such that "class X is Mu is Moose" can dispatch with Moose first. (`fix` (reverse $ fromJust attrs)) $ \run pkgs -> do if null pkgs then return (Left $ NoSuchMethod (cast pkg)) else do subs <- findWithPkg (head pkgs) var
src/Pugs/Lexer.hs view
@@ -184,10 +184,7 @@ return $ concat (intersperse "::" chunks) ruleVerbatimIdentifier :: RuleParser String-ruleVerbatimIdentifier = verbatimRule "identifier" $ do- c <- identStart- cs <- many identLetter- return (c:cs)+ruleVerbatimIdentifier = verbatimRule "identifier" $ ident {- {-|@@ -481,14 +478,24 @@ -- Identifiers & Reserved words ----------------------------------------------------------- identifier, ident :: RuleParser String-identifier = lexeme . try $ ident+identifier = lexeme . try $ (<?> "identifier") ident+ +identBegin = do+ c <- identStart+ cs <- many identLetter+ return (c:cs) -ident- = do{ c <- identStart- ; cs <- many identLetter- ; return (c:cs)- }- <?> "identifier"+identNext = do+ c <- satisfy isAlpha+ cs <- many identLetter+ return (c:cs)++identContinue = fmap concat $ many $ try $ do+ c <- oneOf "'-"+ cs <- identNext+ return (c:cs)++ident = liftM2 (++) identBegin (try identContinue <|> return "") ----------------------------------------------------------- -- White space & symbols
src/Pugs/Parser.hs view
@@ -290,7 +290,7 @@ "grammar" -> "Grammar" _ -> fail "bug" mixinRoles = nub ([ cls | ("does", cls) <- traits])- parentClasses = nub ("Object":[ cls | ("is", cls) <- traits, cls /= "also" ])+ parentClasses = nub ("Mu":[ cls | ("is", cls) <- traits, cls /= "also" ]) case () of _ | elem name parentClasses -> do return (Left $ "Circular class inheritance detected for " ++ sym ++ " '" ++ name ++ "'")@@ -1998,9 +1998,9 @@ then ruleSubNamePossiblyWithTwigil else do twigil <- ruleTwigil name <- case twigil of- "" -> many1 wordAny <|> string "/" <|> string "¢"- "!" -> many wordAny- _ -> many1 wordAny+ "" -> ruleVerbatimIdentifier <|> many1 (oneOf "0123456789") <|> string "/" <|> string "¢"+ "!" -> ruleVerbatimIdentifier <|> return ""+ _ -> ruleVerbatimIdentifier <|> many1 (oneOf "0123456789") return $ sigil ++ twigil ++ name -- XXX - Eventually return "Var" here and verbatimVarNameString can be the "String" form
src/Pugs/Prim.hs view
@@ -105,6 +105,10 @@ op0 "defer" = const $ do env <- ask if envAtomic env then guardSTM retry else fail "Cannot call &defer outside a contend block."+op0 "Int" = const $ return (VType $ mkType "Int")+op0 "Num" = const $ return (VType $ mkType "Num")+op0 "Rat" = const $ return (VType $ mkType "Rat")+op0 "Bool" = const $ return (VType $ mkType "Bool") op0 other = const $ fail ("Unimplemented listOp: " ++ other) -- |Implementation of unary primitive operators and functions@@ -155,6 +159,8 @@ op1 "tan" = op1Floating tan op1 "sqrt" = op1Floating sqrt op1 "atan" = op1Floating atan+op1 "acos" = op1Floating cos+op1 "asin" = op1Floating sin op1 "post:i" = \x -> do n <- fromVal x return $ VComplex (0 :+ n)@@ -211,8 +217,14 @@ op1 "list" = op1Cast VList op1 "pair" = op1Cast $ VList . (map $ \(k, v) -> castV ((VStr k, v) :: VPair)) op1 "~" = op1Cast VStr+op1 "gist" = op1Cast VStr -- Cheat op1 "?" = op1Cast VBool+op1 "so" = op1Cast VBool+op1 "Bool" = op1Cast VBool op1 "int" = op1Cast VInt+op1 "Int" = op1Cast VInt+op1 "Num" = op1Cast VNum+op1 "Rat" = op1Cast VRat op1 "+^" = op1Cast (VInt . pred . negate) -- Arbitrary precision complement- 0 ==> -1 / 1 ==> -2 op1 "~^" = op1Cast (VStr . mapStr complement) op1 "?^" = op1 "!"@@ -684,7 +696,7 @@ glob <- filterPrim =<< asks envGlobal yml <- io $ showYaml (filterUserDefinedPad glob, v) return $ VStr yml-op1 "Object::HOW" = \v -> do+op1 "Mu::HOW" = \v -> do typ <- evalValType v evalExp $ _Var (':':'*':showType typ) op1 "Class::name" = \v -> do@@ -1112,6 +1124,7 @@ op2 "exp" = \x y -> if defined y then op2Num (**) x y else op1Floating exp x+op2 "Rat" = \x y -> op1Cast VRat x -- Cheat, ignore epsilon op2 "Pugs::Internals::sprintf" = \x y -> do -- a single argument is all Haskell can really handle. -- XXX printf should be wrapped in a catch so a mis-typed argument@@ -1304,7 +1317,7 @@ op3 "Str::split" = \x y z -> do op3 "split" y x z op3 "HOW::new" = \t n p -> do- cls <- op3 "Object::new" t n p+ cls <- op3 "Mu::new" t n p meta <- readRef =<< fromVal cls fetch <- doHash meta hash_fetchVal @@ -1328,7 +1341,7 @@ return cls -op3 "Object::new" = \t n p -> do+op3 "Mu::new" = \t n p -> do positionals <- fromVal p typ <- fromVal t named <- fromVal n@@ -1349,7 +1362,7 @@ -- Register finalizers by keeping weakrefs somehow setFinalization obj -op3 "Object::clone" = \t n _ -> do+op3 "Mu::clone" = \t n _ -> do named <- fromVal n (VObject o) <- fromVal t attrs <- readIVar (IHash $ objAttrs o)@@ -1873,6 +1886,8 @@ \\n Num pre cos safe (Num)\ \\n Num pre sin safe (Num)\ \\n Num pre tan safe (Num)\+\\n Num pre acos safe (Num)\+\\n Num pre asin safe (Num)\ \\n Any pre Pugs::Internals::pi safe ()\ \\n Any pre self safe,macro ()\ \\n Bool pre nothing safe ()\@@ -1880,7 +1895,9 @@ \\n Num pre sqrt safe (Num)\ \\n Num spre - safe (Num)\ \\n Str spre ~ safe (Str)\+\\n Str pre gist safe (Any)\ \\n Bool spre ? safe (Bool)\+\\n Bool pre so safe (Any)\ \\n Str spre = unsafe (?IO)\ \\n List spre = unsafe (?IO)\ \\n Str pre readline unsafe (?IO)\@@ -1889,6 +1906,30 @@ \\n Str pre Pugs::Safe::safe_getc safe ()\ \\n Str pre Pugs::Safe::safe_readline safe ()\ \\n Int pre int safe (Int)\+\\n Int pre Int safe ()\+\\n Int pre Int safe (Int)\+\\n Int pre Int safe (Num)\+\\n Int pre Int safe (Rat)\+\\n Int pre Int safe (Bool)\+\\n Num pre Num safe ()\+\\n Num pre Num safe (Int)\+\\n Num pre Num safe (Num)\+\\n Num pre Num safe (Rat)\+\\n Num pre Num safe (Bool)\+\\n Rat pre Rat safe ()\+\\n Rat pre Rat safe (Int)\+\\n Rat pre Rat safe (Int: Any)\+\\n Rat pre Rat safe (Num)\+\\n Rat pre Rat safe (Num: Any)\+\\n Rat pre Rat safe (Rat)\+\\n Rat pre Rat safe (Rat: Any)\+\\n Rat pre Rat safe (Bool)\+\\n Rat pre Rat safe (Bool: Any)\+\\n Bool pre Bool safe ()\+\\n Bool pre Bool safe (Int)\+\\n Bool pre Bool safe (Num)\+\\n Bool pre Bool safe (Rat)\+\\n Bool pre Bool safe (Bool)\ \\n List pre list safe (List)\ \\n Hash pre hash safe (List)\ \\n List pre pair safe (List)\@@ -2036,10 +2077,10 @@ \\n Bool pre flush unsafe (IO)\ \\n Bool pre IO::close unsafe,export (IO:)\ \\n Bool pre Socket::close unsafe,export (Socket:)\-\\n Bool pre die safe (?Object)\+\\n Bool pre die safe (?Mu)\ \\n Bool pre warn safe (List)\-\\n Bool pre fail_ safe (?Object)\-\\n Bool pre fail safe (?Object)\+\\n Bool pre fail_ safe (?Mu)\+\\n Bool pre fail safe (?Mu)\ \\n Socket pre listen unsafe (Int)\ \\n Socket pre connect unsafe (Str, Int)\ \\n Any pre accept unsafe (Any)\@@ -2168,8 +2209,8 @@ \\n Str pre chr safe (Int)\ \\n Int pre ord safe (Str)\ \\n Str pre oct safe (Str)\-\\n Object pre stat unsafe (Str)\-\\n Object pre lstat unsafe (Str)\+\\n Mu pre stat unsafe (Str)\+\\n Mu pre lstat unsafe (Str)\ \\n Int pre from safe (Match)\ \\n Int pre to safe (Match)\ \\n List pre matches safe (Match)\@@ -2182,17 +2223,17 @@ \\n Int pre sign safe (Num)\ \\n Bool pre kill safe (Thread)\ \\n Int pre kill unsafe (Int, List)\-\\n Object pre Object::new safe,export (Object: Named)\-\\n Object pre BUILDALL safe (Object)\-\\n Object pre DESTROYALL safe (Object)\+\\n Mu pre Mu::new safe,export (Mu: Named)\+\\n Mu pre BUILDALL safe (Mu)\+\\n Mu pre DESTROYALL safe (Mu)\ \\n Code pre TEMP safe (rw!Any)\-\\n Object pre Object::clone safe (Object: Named)\-\\n Class pre Object::HOW safe,export (Object)\-\\n Object pre HOW::new safe (Object: Named)\-\\n Object pre HOW::does safe (Object: List)\+\\n Mu pre Mu::clone safe (Mu: Named)\+\\n Class pre Mu::HOW safe,export (Mu)\+\\n Mu pre HOW::new safe (Mu: Named)\+\\n Mu pre HOW::does safe (Mu: List)\ \\n Str pre Class::name safe (Class)\ \\n Hash pre Class::traits safe (Class)\-\\n Object pre WHICH safe (Any)\+\\n Mu pre WHICH safe (Any)\ \\n Int pre Rat::numerator safe (Rat:)\ \\n Int pre Rat::denominator safe (Rat:)\ \\n Bool pre Thread::yield safe (Thread)\
src/Pugs/Prim/Eval.hs view
@@ -52,8 +52,9 @@ loaded <- existsFromRef seen v let file | '.' `elem` mod = mod | otherwise = (concat $ intersperse (getConfig "file_sep") $ split "::" mod) ++ ".pm"+ useExternalTest <- io $ (maybe False (/= "")) `fmap` (getEnv "PUGS_USE_EXTERNAL_TEST") pathName <- case mod of- "Test" -> return "Test.pm"+ "Test" | not useExternalTest -> return "Test.pm" _ -> requireInc incs file (errMsg file incs) if loaded then opEval style pathName "" else do -- %*INC{mod} = { relname => file, pathname => pathName }@@ -70,7 +71,7 @@ ends <- fromVal =<< readRef endAV clearRef endAV rv <- case mod of- "Test" -> shortcutToTestPM+ "Test" | not useExternalTest -> shortcutToTestPM _ -> tryFastEval pathName (pathName ++ ".yml") endAV' <- findSymRef (cast "@*END") glob _ <- doArray (VRef endAV') (`array_unshift` ends)@@ -88,7 +89,7 @@ evl <- asks envEval evl ast tryFastEval pathName pathNameYml = do- io $ print pathNameYml+ -- io $ print pathNameYml ok <- io $ doesFileExist pathNameYml if not ok then slowEval pathName else do isYamlStale <- tryIO False $ do
src/Pugs/Prim/Yaml.hs view
@@ -37,8 +37,8 @@ return (key, val) hv <- io $ (H.fromList H.hashString vals :: IO IHash) return $ VRef (hashRef hv)- Just s | (pre, post) <- Str.splitAt 16 s -- 16 == length "tag:pugs:Object:"- , pre == packBuf "tag:pugs:Object:" -> do+ Just s | (pre, post) <- Str.splitAt 16 s -- 16 == length "tag:pugs:Mu:"+ , pre == packBuf "tag:pugs:Mu:" -> do let typ = unpackBuf post vals <- forM nodes $ \(keyNode, valNode) -> do key <- fromVal =<< fromYaml keyNode@@ -110,7 +110,7 @@ -- parens, which is, of course, wrong. hash <- fromVal v :: Eval VHash attrs <- toYaml $ VRef (hashRef hash)- return $ tagNode (Just $ packBuf $ "tag:pugs:Object:" ++ showType (objType obj)) attrs+ return $ tagNode (Just $ packBuf $ "tag:pugs:Mu:" ++ showType (objType obj)) attrs toYaml (VRule MkRulePGE{rxRule=rule, rxGlobal=global, rxStringify=stringify, rxAdverbs=adverbs}) = do adverbs' <- toYaml adverbs return . mkTagNode "tag:pugs:Rule" $ EMap
src/Pugs/Types.hs view
@@ -827,7 +827,7 @@ will produce the list of types @-Any, Void, Object, Scalar, Complex, Num+Any, Void, Mu, Scalar, Complex, Num @ This function does /not/ expect to be given junctive types.@@ -865,7 +865,7 @@ initTreeCount = countTree initTree rawTree :: Tree ID-rawTree = fmap cast $! Node "Object"+rawTree = fmap cast $! Node "Mu" [ Node "Any" [ Node "Item" [ Node "List"
src/Pugs/Val.hs view
@@ -35,7 +35,7 @@ itemVal = return valMeta :: Val -> PureStr-valMeta _ = cast "Object"+valMeta _ = cast "Mu" valShow :: Val -> PureStr valShow _ = cast "<opaque>"
src/Pugs/Version.hs view
@@ -14,10 +14,10 @@ -- #include "pugs_version.h" #ifndef PUGS_VERSION-#define PUGS_VERSION "6.2.13.20111008"+#define PUGS_VERSION "6.2.13.dev" #endif #ifndef PUGS_DATE-#define PUGS_DATE "October 8, 2011"+#define PUGS_DATE "Today" #endif #ifndef PUGS_SVN_REVISION #define PUGS_SVN_REVISION 0@@ -33,7 +33,7 @@ versnum = PUGS_VERSION date = PUGS_DATE version = name ++ ", version " ++ versnum ++ ", " ++ date ++ revision-copyright = "Copyright 2005-2011, The Pugs Contributors"+copyright = "Copyright 2005-2012, The Pugs Contributors" revnum = show (PUGS_SVN_REVISION :: Integer) revision | rev <- revnum