Changeset 9009

Show
Ignore:
Timestamp:
02/15/06 16:10:35 (3 years ago)
Author:
audreyt
Message:

* Prelude-YAML compilation works:

time ./pugs -CParse-YAML src/perl6/Prelude.pm > Prelude.yml

takes 12 seconds on my laptop, resulting in a 533036-bytes
file which we may or may not want to install as part of pugs's lib.
on the other hand, it's 16k when gzipped, and 8k when bzipped.

Location:
src/Pugs
Files:
3 modified

Legend:

Unmodified
Added
Removed

  • src/Pugs/AST/Internals.hs

    r9007 r9009  
    746746type VBlock = Exp 
    747747data VControl 
    748     = ControlLeave !(Env -> Eval Bool) !Val 
    749     | ControlExit  !ExitCode 
     748    = ControlExit  !ExitCode 
    750749    | ControlEnv   !Env 
    751     deriving (Show, Eq, Ord, Typeable) {-!derive: YAML!-} 
     750 -- | ControlLeave !(Env -> Eval Bool) !Val 
     751    deriving (Show, Eq, Ord, Typeable) 
    752752 
    753753{-| 
    … …  
    11371137    , envInitDat :: !(TVar InitDat)      -- ^ BEGIN result information 
    11381138    }  
    1139     deriving (Show, Eq, Ord, Typeable) {-!derive: YAML!-} 
     1139    deriving (Show, Eq, Ord, Typeable) 
    11401140 
    11411141{-| 
    … …  
    18251825        } 
    18261826 
    1827 instance (Typeable a, Typeable b) => YAML (a -> Eval b) 
    1828 instance (Typeable a) => YAML (Eval a) 
     1827fakeEval :: MonadIO m => Eval Val -> m Val 
     1828fakeEval = liftIO . runEvalIO _FakeEnv 
     1829 
     1830instance YAML ([Val] -> Eval Val) where 
     1831    asYAML _ = return nilNode 
     1832    fromYAML _ = return (const $ return VUndef) 
     1833instance YAML (Maybe Env) where 
     1834    asYAML _ = return nilNode 
     1835    fromYAML _ = return Nothing 
     1836instance YAML (Eval Val) where 
     1837    asYAML x = asYAML =<< fakeEval x 
     1838    fromYAML x = return =<< fromYAML x 
    18291839instance YAML a => YAML (Map String a) where 
    18301840    asYAML x = asYAMLmap "Map" $ Map.toList (Map.map asYAML x) 
    … …  
    18341844instance YAML VRef where 
    18351845    asYAML (MkRef (ICode cv)) = do 
    1836         VCode vsub  <- liftIO $ runEvalIO _FakeEnv $ fmap VCode (code_fetch cv) 
     1846        VCode vsub  <- fakeEval $ fmap VCode (code_fetch cv) 
    18371847        vsubC       <- asYAML vsub 
    18381848        return $ mkTagNode (tagHs "VCode") (el vsubC) 
    18391849    asYAML (MkRef (IScalar sv)) = do 
    1840         val <- liftIO $ runEvalIO _FakeEnv $ scalar_fetch sv 
     1850        val <- fakeEval $ scalar_fetch sv 
    18411851        svC <- asYAML val 
    18421852        let tag = if scalar_iType sv == mkType "Scalar::Const" 
    18431853                    then "VScalar" else "IScalar" 
    18441854        return $ mkTagNode (tagHs tag) (el svC) 
     1855    asYAML (MkRef (IArray av)) = do 
     1856        VList vals <- fakeEval $ fmap VList (array_fetch av) 
     1857        avC <- asYAML vals 
     1858        return $ mkTagNode (tagHs "Array") (el avC) 
    18451859    asYAML ref = do 
    1846         val <- liftIO $ runEvalIO _FakeEnv $ readRef ref 
     1860        val <- fakeEval $ readRef ref 
    18471861        svC <- asYAML val 
     1862        liftIO $ print "====>" 
    18481863        liftIO $ print svC 
    18491864        fail ("not implemented: asYAML \"" ++ showType (refType ref) ++ "\"") 
    … …  
    18541869    fromYAML node@MkYamlNode{tag=Just "tag:hs:IScalar"} = 
    18551870        fmap MkRef (newScalar =<< fromYAML node) 
    1856  
     1871    fromYAML node@MkYamlNode{tag=Just "tag:hs:Array"} = 
     1872        fmap MkRef (newArray =<< fromYAML node) 
     1873 
     1874instance YAML VControl 
    18571875instance YAML (Set Val) 
    18581876instance YAML (VThread Val) 
    18591877instance YAML ClassTree 
    18601878instance YAML Dynamic 
    1861 instance YAML ExitCode 
    18621879instance YAML Pragma 
    18631880instance YAML ProcessHandle 
    … …  
    18721889instance Typeable Unique where typeOf _ = typeOf () 
    18731890instance Typeable ProcessHandle where typeOf _ = typeOf () 
    1874 instance Typeable ExitCode where typeOf _ = typeOf () 
    18751891instance Typeable Regex where typeOf _ = typeOf () 
    18761892instance Typeable1 Tree where typeOf1 _ = typeOf () 
    … …  
    20332049    asYAML (PerlSV aa) = asYAMLseq "PerlSV" [asYAML aa] 
    20342050 
    2035 instance YAML VControl where 
    2036     asYAML (ControlLeave aa ab) = asYAMLseq "ControlLeave" 
    2037            [asYAML aa , asYAML ab] 
    2038     asYAML (ControlExit aa) = asYAMLseq "ControlExit" [asYAML aa] 
    2039     asYAML (ControlEnv aa) = asYAMLseq "ControlEnv" [asYAML aa] 
    2040  
    20412051instance YAML VJunc where 
    20422052    asYAML (MkJunc aa ab ac) = asYAMLmap "MkJunc" 
    … …  
    21342144    asYAML (NonTerm aa) = asYAMLseq "NonTerm" [asYAML aa] 
    21352145 
    2136 instance YAML Env where 
    2137     asYAML (MkEnv aa ab ac ad ae af ag ah ai aj ak al am an ao ap) = 
    2138            asYAMLmap "MkEnv" 
    2139            [("envContext", asYAML aa) , ("envLValue", asYAML ab) , 
    2140             ("envLexical", asYAML ac) , ("envImplicit", asYAML ad) , 
    2141             ("envGlobal", asYAML ae) , ("envPackage", asYAML af) , 
    2142             ("envClasses", asYAML ag) , ("envEval", asYAML ah) , 
    2143             ("envCaller", asYAML ai) , ("envOuter", asYAML aj) , 
    2144             ("envBody", asYAML ak) , ("envDepth", asYAML al) , 
    2145             ("envDebug", asYAML am) , ("envPos", asYAML an) , 
    2146             ("envPragmas", asYAML ao) , ("envInitDat", asYAML ap)] 
    2147  
    21482146instance YAML InitDat where 
    21492147    asYAML (MkInitDat aa) = asYAMLmap "MkInitDat" 

  • src/Pugs/AST/Internals.hs-drift

    r9007 r9009  
    752752type VBlock = Exp 
    753753data VControl 
    754     = ControlLeave !(Env -> Eval Bool) !Val 
    755     | ControlExit  !ExitCode 
     754    = ControlExit  !ExitCode 
    756755    | ControlEnv   !Env 
    757     deriving (Show, Eq, Ord, Typeable) {-!derive: YAML!-} 
     756 -- | ControlLeave !(Env -> Eval Bool) !Val 
     757    deriving (Show, Eq, Ord, Typeable) 
    758758 
    759759{-| 
    … …  
    11431143    , envInitDat :: !(TVar InitDat)      -- ^ BEGIN result information 
    11441144    }  
    1145     deriving (Show, Eq, Ord, Typeable) {-!derive: YAML!-} 
     1145    deriving (Show, Eq, Ord, Typeable) 
    11461146 
    11471147{-| 
    … …  
    18311831        } 
    18321832 
    1833 instance (Typeable a, Typeable b) => YAML (a -> Eval b) 
    1834 instance (Typeable a) => YAML (Eval a) 
     1833fakeEval :: MonadIO m => Eval Val -> m Val 
     1834fakeEval = liftIO . runEvalIO _FakeEnv 
     1835 
     1836instance YAML ([Val] -> Eval Val) where 
     1837    asYAML _ = return nilNode 
     1838    fromYAML _ = return (const $ return VUndef) 
     1839instance YAML (Maybe Env) where 
     1840    asYAML _ = return nilNode 
     1841    fromYAML _ = return Nothing 
     1842instance YAML (Eval Val) where 
     1843    asYAML x = asYAML =<< fakeEval x 
     1844    fromYAML x = return =<< fromYAML x 
    18351845instance YAML a => YAML (Map String a) where 
    18361846    asYAML x = asYAMLmap "Map" $ Map.toList (Map.map asYAML x) 
    … …  
    18401850instance YAML VRef where 
    18411851    asYAML (MkRef (ICode cv)) = do 
    1842         VCode vsub  <- liftIO $ runEvalIO _FakeEnv $ fmap VCode (code_fetch cv) 
     1852        VCode vsub  <- fakeEval $ fmap VCode (code_fetch cv) 
    18431853        vsubC       <- asYAML vsub 
    18441854        return $ mkTagNode (tagHs "VCode") (el vsubC) 
    18451855    asYAML (MkRef (IScalar sv)) = do 
    1846         val <- liftIO $ runEvalIO _FakeEnv $ scalar_fetch sv 
     1856        val <- fakeEval $ scalar_fetch sv 
    18471857        svC <- asYAML val 
    18481858        let tag = if scalar_iType sv == mkType "Scalar::Const" 
    18491859                    then "VScalar" else "IScalar" 
    18501860        return $ mkTagNode (tagHs tag) (el svC) 
     1861    asYAML (MkRef (IArray av)) = do 
     1862        VList vals <- fakeEval $ fmap VList (array_fetch av) 
     1863        avC <- asYAML vals 
     1864        return $ mkTagNode (tagHs "Array") (el avC) 
    18511865    asYAML ref = do 
    1852         val <- liftIO $ runEvalIO _FakeEnv $ readRef ref 
     1866        val <- fakeEval $ readRef ref 
    18531867        svC <- asYAML val 
     1868        liftIO $ print "====>" 
    18541869        liftIO $ print svC 
    18551870        fail ("not implemented: asYAML \"" ++ showType (refType ref) ++ "\"") 
    … …  
    18601875    fromYAML node@MkYamlNode{tag=Just "tag:hs:IScalar"} = 
    18611876        fmap MkRef (newScalar =<< fromYAML node) 
    1862  
     1877    fromYAML node@MkYamlNode{tag=Just "tag:hs:Array"} = 
     1878        fmap MkRef (newArray =<< fromYAML node) 
     1879 
     1880instance YAML VControl 
    18631881instance YAML (Set Val) 
    18641882instance YAML (VThread Val) 
    18651883instance YAML ClassTree 
    18661884instance YAML Dynamic 
    1867 instance YAML ExitCode 
    18681885instance YAML Pragma 
    18691886instance YAML ProcessHandle 
    … …  
    18781895instance Typeable Unique where typeOf _ = typeOf () 
    18791896instance Typeable ProcessHandle where typeOf _ = typeOf () 
    1880 instance Typeable ExitCode where typeOf _ = typeOf () 
    18811897instance Typeable Regex where typeOf _ = typeOf () 
    18821898instance Typeable1 Tree where typeOf1 _ = typeOf () 

  • src/Pugs/CodeGen/YAML.hs

    r8687 r9009  
    1111genParseYAML :: Eval Val 
    1212genParseYAML = do 
    13     -- glob    <- asks envGlobal 
     13    glob    <- asks envGlobal 
    1414    main    <- asks envBody 
    15     yaml    <- liftIO (showYaml main) 
     15    yaml    <- liftIO (showYaml (glob, main)) 
    1616    return (VStr yaml) 
    1717