Changeset 4656

Show
Ignore:
Timestamp:
06/15/05 00:01:16 (4 years ago)
Author:
autrijus
svk:copy_cache_prev:
6394
Message:

* Switch to functional dependency for the "Translatable" class.
* add usual svn props for Pugs.Compile.PIR.

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • src/Pugs/Compile/PIR.hs

    • Property svn:mime-type set to text/plain; charset=UTF-8
    • Property svn:eol-style set to native
    r4655 r4656  
    44import Pugs.Internals 
    55import Pugs.AST 
    6 import Pugs.Pretty 
    76import Emit.PIR 
    87import Text.PrettyPrint 
    … …  
    2827type Trans a = WriterT [Stmt] (ReaderT TEnv IO) a 
    2928 
    30 class Compile x y where 
     29class (Show x) => Compile x y where 
    3130    compile :: x -> Comp (PAST y) 
    32     -- compile x = fail ("Unrecognized construct: " ++ show x) 
    33  
    34 {- 
    35 instance Compile Exp PAST where 
    36     compile (Stmts this rest) = do 
    37         thisC <- compile this 
    38         restC <- compile rest 
    39         return $ thisC $+$ restC 
    40  
     31    compile x = fail ("Unrecognized construct: " ++ show x) 
    4132 
    4233class Translate x y | x -> y where 
    4334    trans :: x -> Trans y 
    44  
    45 instance Translate PAST [Stmt] where 
    46     trans  
    47  
    48 -} 
     35    trans _ = fail "Untranslatable construct!" 
    4936 
    5037instance Compile Exp [Stmt] where 
    … …  
    9380    hPutStrLn stderr $ "*** " ++ str ++ ": " ++ show val 
    9481 
    95 trans :: PAST a -> Trans a 
    96 trans PNil = return [] 
    97 trans PNoop = return (StmtComment "") 
    98 trans (PPos pos) = do 
    99     tell [StmtLine (posName pos) (posBeginLine pos)] 
    100     trans PNoop 
    101 trans (PLit lit) = do 
    102     -- generate fresh supply and things... 
    103     litC    <- trans lit 
    104     tvar    <- asks tReg 
    105     pmc     <- liftIO $ liftSTM $ do 
    106         cur <- readTVar tvar 
    107         writeTVar tvar (cur + 1) 
    108         return cur 
    109     tell    [ StmtIns $ InsNew (PMC pmc) PerlUndef 
    110             , StmtIns $ InsAssign (PMC pmc) litC 
    111             ] 
    112     return (PMC pmc) 
    113 trans (PVal (VStr str)) = return $ LitStr str 
    114 trans (PVal _) = error "Unknown val" 
    115 trans (PVar var) = error "Unknown var" 
    116 trans (PApp (PVar name) args) = do 
    117     argsC <- mapM trans args 
    118     return $ StmtIns $ InsFun [] name argsC 
    119 trans (PStmts this rest) = do 
    120     thisC <- trans this 
    121     restC <- trans rest 
    122     tell (thisC:restC) 
    123     return [] 
     82instance Translate (PAST a) a where 
     83    trans PNil = return [] 
     84    trans PNoop = return (StmtComment "") 
     85    trans (PPos pos) = do 
     86        tell [StmtLine (posName pos) (posBeginLine pos)] 
     87        trans PNoop 
     88    trans (PLit lit) = do 
     89        -- generate fresh supply and things... 
     90        litC    <- trans lit 
     91        tvar    <- asks tReg 
     92        pmc     <- liftIO $ liftSTM $ do 
     93            cur <- readTVar tvar 
     94            writeTVar tvar (cur + 1) 
     95            return cur 
     96        tell    [ StmtIns $ InsNew (PMC pmc) PerlUndef 
     97                , StmtIns $ InsAssign (PMC pmc) litC 
     98                ] 
     99        return (PMC pmc) 
     100    trans (PVal (VStr str)) = return $ LitStr str 
     101    trans (PVal _) = error "Unknown val" 
     102    trans (PVar var) = error "Unknown var" 
     103    trans (PApp (PVar name) args) = do 
     104        argsC <- mapM trans args 
     105        return $ StmtIns $ InsFun [] name argsC 
     106    trans (PStmts this rest) = do 
     107        thisC <- trans this 
     108        restC <- trans rest 
     109        tell (thisC:restC) 
     110        return [] 
    124111 
    125112genPIR' :: Eval Val