Changeset 4869

Show
Ignore:
Timestamp:
06/20/05 13:45:16 (4 years ago)
Author:
autrijus
svk:copy_cache_prev:
6641
Message:

* squash some wanrnings.

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • src/Pugs/Compile/PIR.hs

    r4861 r4869  
    1616 
    1717#ifndef HADDOCK 
    18 data PAST a where 
    19     PNil        :: PAST [a] 
    20     PNoop       :: PAST Stmt 
    21  
    22     PRaw        :: !Exp -> PAST Stmt -- XXX HACK! 
    23     PRawName    :: !VarName -> PAST Expression -- XXX HACK! 
    24  
    25     PExp        :: !(PAST LValue) -> PAST Expression  
    26     PLit        :: !(PAST Literal) -> PAST Expression 
    27     PPos        :: !Pos -> !Exp -> PAST a -> PAST a 
    28     PStmt       :: !(PAST Expression) -> PAST Stmt  
    29     PThunk      :: !(PAST Expression) -> PAST Expression  
    30     PBlock      :: !(PAST [Stmt]) -> PAST Expression  
    31  
    32     PVal        :: !Val -> PAST Literal 
    33     PVar        :: !VarName -> PAST LValue 
    34  
    35     PStmts      :: !(PAST Stmt) -> PAST [Stmt] -> PAST [Stmt] 
    36     PApp        :: !TCxt -> !(PAST Expression) -> ![PAST Expression] -> PAST LValue 
    37     PAssign     :: ![PAST LValue] -> !(PAST Expression) -> PAST LValue 
    38     PBind       :: ![PAST LValue] -> !(PAST Expression) -> PAST LValue 
    39     PPad        :: ![(VarName, PAST Expression)] -> !(PAST [Stmt]) -> PAST [Stmt] 
    40  
    41     PSub        :: !SubName -> ![TParam] -> !(PAST [Stmt]) -> PAST Decl 
     18data PIL a where 
     19    PNil        :: PIL [a] 
     20    PNoop       :: PIL Stmt 
     21 
     22    PRaw        :: !Exp -> PIL Stmt -- XXX HACK! 
     23    PRawName    :: !VarName -> PIL Expression -- XXX HACK! 
     24 
     25    PExp        :: !(PIL LValue) -> PIL Expression  
     26    PLit        :: !(PIL Literal) -> PIL Expression 
     27    PPos        :: !Pos -> !Exp -> PIL a -> PIL a 
     28    PStmt       :: !(PIL Expression) -> PIL Stmt  
     29    PThunk      :: !(PIL Expression) -> PIL Expression  
     30    PBlock      :: !(PIL [Stmt]) -> PIL Expression  
     31 
     32    PVal        :: !Val -> PIL Literal 
     33    PVar        :: !VarName -> PIL LValue 
     34 
     35    PStmts      :: !(PIL Stmt) -> PIL [Stmt] -> PIL [Stmt] 
     36    PApp        :: !TCxt -> !(PIL Expression) -> ![PIL Expression] -> PIL LValue 
     37    PAssign     :: ![PIL LValue] -> !(PIL Expression) -> PIL LValue 
     38    PBind       :: ![PIL LValue] -> !(PIL Expression) -> PIL LValue 
     39    PPad        :: ![(VarName, PIL Expression)] -> !(PIL [Stmt]) -> PIL [Stmt] 
     40 
     41    PSub        :: !SubName -> ![TParam] -> !(PIL [Stmt]) -> PIL Decl 
    4242#endif 
    4343 
    4444data TParam = MkTParam 
    4545    { tpParam   :: !Param 
    46     , tpDefault :: !(Maybe (PAST Expression)) 
     46    , tpDefault :: !(Maybe (PIL Expression)) 
    4747    } 
    4848    deriving (Show, Typeable) 
    … …  
    6363-} 
    6464 
    65 instance Show (PAST a) where 
     65instance Show (PIL a) where 
    6666    show (PVal x) = "(PVal " ++ show x ++ ")" 
    6767    show (PVar x) = "(PVar " ++ show x ++ ")" 
    … …  
    9898type TransMonad = WriterT [Stmt] (ReaderT TEnv IO) 
    9999 
    100 {-| Currently only 'Exp' → 'PAST' -} 
     100{-| Currently only 'Exp' → 'PIL' -} 
    101101class (Show a, Typeable b) => Compile a b where 
    102102    compile :: a -> Comp b 
    103103    compile x = fail ("Unrecognized construct: " ++ show x) 
    104104 
    105 {-| Currently only 'PAST' → 'PIR' -} 
     105{-| Currently only 'PIL' → 'PIR' -} 
    106106class (Show a, Typeable b) => Translate a b | a -> b where 
    107107    trans :: a -> Trans b 
    108108    trans _ = fail "Untranslatable construct!" 
    109109 
    110 instance Compile (Var, [(TVar Bool, TVar VRef)]) (PAST Decl) where 
     110instance Compile (Var, [(TVar Bool, TVar VRef)]) (PIL Decl) where 
    111111    compile = compError 
    112112 
    … …  
    121121            } 
    122122 
    123 instance Compile Pad (PAST PIR) where 
    124     compile = compError 
    125  
    126 {-| Compiles a 'Pad' to a list of 'PAST Decl's. Currently, only subroutines and 
     123{-| Compiles a 'Pad' to a list of 'PIL Decl's. Currently, only subroutines and 
    127124    @\@*END@ are compiled. -} 
    128 instance Compile Pad [PAST Decl] where 
     125instance Compile Pad [PIL Decl] where 
    129126    compile pad = do 
    130127        entries' <- mapM canCompile entries 
    … …  
    144141            cvList  <- fromVals =<< readRef ref :: Comp [VCode] 
    145142            decls   <- forM ([0..] `zip` cvList) $ \(i :: Int, cv) -> do 
    146                 compile (("&*END_" ++ show i), cv) :: Comp [PAST Decl] 
     143                compile (("&*END_" ++ show i), cv) :: Comp [PIL Decl] 
    147144            compile ("&*END", concat decls) 
    148145        canCompile _ = return [] 
    … …  
    151148            else compile (name, vsub) 
    152149 
    153 instance Compile ([Char], [PAST Decl]) [PAST Decl] where 
     150instance Compile ([Char], [PIL Decl]) [PIL Decl] where 
    154151    compile (name, decls) = do 
    155152        let bodyC = [ PStmts . PStmt . PExp $ PApp tcVoid (PExp (PVar sub)) [] 
    … …  
    158155        return (PSub name [] (combine bodyC PNil):decls) 
    159156 
    160 instance Compile ([Char], VCode) [PAST Decl] where 
     157instance Compile ([Char], VCode) [PIL Decl] where 
    161158    compile (name, MkCode{ subBody = Syn "block" [body], subParams = params }) = do 
    162159        bodyC   <- enter cxtItemAny $ compile body 
    … …  
    166163 
    167164{- 
    168 instance Compile [(TVar Bool, TVar VRef)] (PAST Expression) where 
     165instance Compile [(TVar Bool, TVar VRef)] (PIL Expression) where 
    169166    compile _ = return (PLit $ PVal undef) 
    170167-} 
    171168 
    172 instance Compile (String, [(TVar Bool, TVar VRef)]) (PAST Expression) where 
     169instance Compile (String, [(TVar Bool, TVar VRef)]) (PIL Expression) where 
    173170    compile (name, _) = return $ PRawName name 
    174171 
    175 instance Compile Exp (PAST [Stmt]) where 
     172instance Compile Exp (PIL [Stmt]) where 
    176173    compile (Pos pos rest) = fmap (PPos pos rest) $ compile rest 
    177174    compile (Cxt cxt rest) = enter cxt $ compile rest 
    … …  
    191188    enter cxt = local (\e -> e{ tCxt = cxt }) 
    192189 
    193 compileStmts :: Exp -> Comp (PAST [Stmt]) 
     190compileStmts :: Exp -> Comp (PIL [Stmt]) 
    194191compileStmts exp = case exp of 
    195192    Stmts this Noop -> do 
    … …  
    208205    _           -> compile (Stmts exp Noop) 
    209206 
    210 instance Compile Val (PAST Stmt) where 
     207instance Compile Val (PIL Stmt) where 
    211208    compile = fmap PStmt . compile . Val 
    212209 
    213 instance Compile Exp (PAST Stmt) where 
     210instance Compile Exp (PIL Stmt) where 
    214211    compile (Pos pos rest) = fmap (PPos pos rest) $ compile rest 
    215212    compile (Cxt cxt rest) = enter cxt $ compile rest 
    … …  
    257254    compile x = compError x 
    258255 
    259 instance Compile Exp (PAST LValue) where 
     256instance Compile Exp (PIL LValue) where 
    260257    compile (Pos pos rest) = fmap (PPos pos rest) $ compile rest 
    261258    compile (Cxt cxt rest) = enter cxt $ compile rest 
    … …  
    301298    compile exp = compError exp 
    302299 
    303 compLoop :: Exp -> Comp (PAST LValue) 
     300compLoop :: Exp -> Comp (PIL LValue) 
    304301compLoop (Syn name [cond, body]) = do 
    305302    cxt     <- askTCxt 
    … …  
    313310    appropriate function call (@&statement_control:if@ or 
    314311    @&statement_control:unless@). -} 
    315 compConditional :: Exp -> Comp (PAST LValue) 
     312compConditional :: Exp -> Comp (PIL LValue) 
    316313compConditional (Syn name exps) = do 
    317314    [condC, trueC, falseC] <- compile exps 
    … …  
    321318compConditional exp = compError exp 
    322319 
    323 {-| Compiles various 'Exp's to 'PAST Expression's. -} 
    324 instance Compile Exp (PAST Expression) where 
     320{-| Compiles various 'Exp's to 'PIL Expression's. -} 
     321instance Compile Exp (PIL Expression) where 
    325322    compile (Pos pos rest) = fmap (PPos pos rest) $ compile rest 
    326323    compile (Cxt cxt rest) = enter cxt $ compile rest 
    … …  
    348345 
    349346compError :: forall a b. Compile a b => a -> Comp b 
    350 compError = die $ "Compile error -- invalid PAST " 
     347compError = die $ "Compile error -- invalid PIL " 
    351348    ++ (drop 12 . show $ typeOf (undefined :: b)) 
    352349 
    … …  
    355352    ++ (show $ typeOf (undefined :: b)) 
    356353 
    357 {-| Compiles a 'Val' to a 'PAST Literal'. -} 
    358 instance Compile Val (PAST Literal) where 
     354{-| Compiles a 'Val' to a 'PIL Literal'. -} 
     355instance Compile Val (PIL Literal) where 
    359356    compile val = return $ PVal val 
    360357 
    … …  
    368365    hPutStrLn stderr $ "*** " ++ str ++ ":\n    " ++ show val 
    369366 
    370 instance Typeable1 PAST where 
     367instance Typeable1 PIL where 
    371368    typeOf1 _ = typeOf () 
    372369 
    373 instance (Typeable a) => Translate (PAST a) a where 
     370instance (Typeable a) => Translate (PIL a) a where 
    374371    trans PNil = return [] 
    375372    trans PNoop = return (StmtComment "") 
    … …  
    622619    glob        <- askGlobal 
    623620    main        <- asks envBody 
    624     globPAST    <- compile glob 
    625     mainPAST    <- compile main 
    626     globPIR     <- runTransGlob tenv globPAST :: Eval [Decl] 
    627     mainPIR     <- runTransMain tenv mainPAST :: Eval [Stmt] 
     621    globPIL    <- compile glob 
     622    mainPIL    <- compile main 
     623    globPIR     <- runTransGlob tenv globPIL :: Eval [Decl] 
     624    mainPIR     <- runTransMain tenv mainPIL :: Eval [Stmt] 
    628625    return . VStr . unlines $ 
    629626        [ "#!/usr/bin/env parrot" 
    … …  
    656653                       ,evalError =EvalErrorFatal} 
    657654 
    658 runTransGlob :: TEnv -> [PAST Decl] -> Eval [Decl] 
     655runTransGlob :: TEnv -> [PIL Decl] -> Eval [Decl] 
    659656runTransGlob tenv = mapM $ fmap fst . liftIO . (`runReaderT` tenv) . runWriterT . trans 
    660657 
    661 runTransMain :: TEnv -> PAST [Stmt] -> Eval [Stmt] 
     658runTransMain :: TEnv -> PIL [Stmt] -> Eval [Stmt] 
    662659runTransMain tenv = fmap snd . liftIO . (`runReaderT` tenv) . runWriterT . trans 
    663660