Changeset 10762 for src/Pugs/CodeGen

Show
Ignore:
Timestamp:
06/20/06 17:59:49 (2 years ago)
Author:
gaal
Message:

* refactor Pugs.CodeGen?.YAML a bit
* introduce filterPrim, which is supposed to weed out things like handles

in AST dumps

* unfortunately, it doesn't in Pugs::Internals::emit_yaml (though it does

work in -CParse::YAML).

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • src/Pugs/CodeGen/YAML.hs

    r10301 r10762  
    88import Pugs.PIL1 
    99import DrIFT.YAML 
    10 import qualified Data.Map as Map 
    1110 
    12 genParseHsYAML :: Eval Val 
    13 genParseHsYAML = do 
    14     glob        <- asks envGlobal 
    15     MkPad pad   <- liftSTM $ readTVar glob 
    16     pad'        <- fmap (MkPad . Map.fromAscList . catMaybes) . mapM checkPrim $ Map.toAscList pad 
    17     -- munge the glob to filter out prim stuff in it 
    18     main    <- asks envBody 
    19     yaml    <- liftIO $ toYamlNode $ mkCompUnit "<unused>" pad' main 
    20     return (VStr $ show yaml) 
     11genParseHsYAML, genParseYAML :: Eval Val 
     12genParseHsYAML = doGenParseYAML (fmap show . toYamlNode) 
     13genParseYAML   = doGenParseYAML showYaml 
    2114 
    22 genParseYAML :: Eval Val 
    23 genParseYAML = do 
    24     glob        <- asks envGlobal 
    25     MkPad pad   <- liftSTM $ readTVar glob 
    26     pad'        <- fmap (MkPad . Map.fromAscList . catMaybes) . mapM checkPrim $ Map.toAscList pad 
    27     -- munge the glob to filter out prim stuff in it 
    28     main    <- asks envBody 
    29     yaml    <- liftIO $ showYaml $ mkCompUnit "<unused>" pad' main 
    30     return (VStr yaml) 
    31  
    32 checkPrim :: (String, PadEntry) -> Eval (Maybe (String, PadEntry)) 
    33 checkPrim ((':':'*':_), _) = return Nothing 
    34 checkPrim e@((_, MkEntry (_, tv))) = do 
    35     rv <- isPrim tv 
    36     return $ if rv then Nothing else Just e 
    37 checkPrim (key, MkEntryMulti xs) = do 
    38     xs' <- filterM (fmap not . isPrim . snd) xs 
    39     return $ if null xs' then Nothing else Just (key, MkEntryMulti xs') 
    40  
    41 isPrim :: TVar VRef -> Eval Bool 
    42 isPrim tv = do 
    43     vref <- liftSTM $ readTVar tv 
    44     case vref of 
    45         MkRef (ICode cv)    -> fmap (isPrimVal . VCode) (code_fetch cv) 
    46         MkRef (IScalar sv)  -> fmap isPrimVal (scalar_fetch sv) 
    47         _                   -> return False 
    48     where 
    49     isPrimVal (VCode MkCode{ subBody = Prim _ }) = True 
    50     isPrimVal _ = False 
     15doGenParseYAML :: (CompUnit -> IO String) -> Eval Val 
     16doGenParseYAML f = do 
     17    pad  <- filterPrim =<< asks envGlobal 
     18    main <- asks envBody 
     19    yaml <- liftIO $ f $ mkCompUnit "<unused>" pad main 
     20    return $ VStr yaml 
    5121 
    5222genYAML :: Eval Val 
    … …  
    5424    penv <- compile () :: Eval PIL_Environment 
    5525    yaml <- liftIO (showYaml penv) 
    56     return (VStr yaml) 
     26    return $ VStr yaml