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

* repair pugs -C tests.
* Pugs.Compile.Parrot is now gone; -CParrot etc becomes an

alias to -CPIR etc.

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • src/Pugs/Compile/PIR.hs

    r4869 r4871  
    11{-# OPTIONS_GHC -fglasgow-exts -fno-warn-orphans -funbox-strict-fields -fallow-undecidable-instances -cpp #-} 
    22 
    3 module Pugs.Compile.PIR (genPIR') where 
    4 import Pugs.Compile.Parrot 
     3module Pugs.Compile.PIR (genPIR) where 
    54import Pugs.Internals 
    65import Pugs.AST 
    … …  
    2019    PNoop       :: PIL Stmt 
    2120 
    22     PRaw        :: !Exp -> PIL Stmt -- XXX HACK! 
    2321    PRawName    :: !VarName -> PIL Expression -- XXX HACK! 
    2422 
    … …  
    7977    show (PThunk x) = "(PThunk " ++ show x ++ ")" 
    8078    show (PBlock x) = "(PBlock " ++ show x ++ ")" 
    81     show (PRaw x) = "(PRaw " ++ show x ++ ")" 
    8279    show (PRawName x) = "(PRawName " ++ show x ++ ")" 
    8380    show (PSub x y z) = "(PSub " ++ show x ++ " " ++ show y ++ " " ++ show z ++ ")" 
    … …  
    175172    compile (Stmts (Pad SMy pad exp) rest) = do 
    176173        expC    <- compile $ mergeStmts exp rest 
    177         padC    <- mapM compile (padToList pad) 
     174        padC    <- compile $ padToList pad 
    178175        return $ PPad ((map fst (padToList pad)) `zip` padC) expC 
    179176    compile exp = compileStmts exp 
    … …  
    494491        tellLabel endC 
    495492        return (ExpLV this) 
    496     trans (PRaw exp) = do 
    497         env <- asks tEnv 
    498         raw <- liftIO $ runEvalIO env{ envStash = "$P0" } $ do 
    499             doc <- compile' exp 
    500             return $ VStr (render doc) 
    501         return $ StmtRaw (text $ vCast raw) 
    502493    trans (PRawName name) = do 
    503494        -- generate fresh supply and things... 
    … …  
    597588    return $ reg (VAR var) 
    598589 
     590padSort :: (Var, [(TVar Bool, TVar VRef)]) -> (String, [(a, b)]) -> Ordering 
     591padSort ((a::[Char]), [(_, _)]) ((b::[Char]), [(_, _)]) 
     592    | (head a == ':' && head b == '&') = LT 
     593    | (head b == ':' && head a == '&') = GT 
     594    | otherwise = GT 
     595padSort _ _ = EQ 
     596 
    599597varText :: String -> Doc 
    600598varText ('$':name)  = text $ "s__" ++ escaped name 
    … …  
    611609 
    612610{-| Compiles the current environment to PIR code. -} 
    613 genPIR' :: Eval Val 
    614 genPIR' = do 
     611genPIR :: Eval Val 
     612genPIR = do 
    615613    tenv        <- initTEnv 
    616614    -- Load the PIR Prelude. 
    617     local (\env -> env{envDebug = Nothing}) $ do 
     615    local (\env -> env{ envDebug = Nothing }) $ do 
    618616        opEval style "<prelude-pir>" preludeStr 
    619617    glob        <- askGlobal 
    620618    main        <- asks envBody 
    621     globPIL    <- compile glob 
    622     mainPIL    <- compile main 
     619    globPIL     <- compile glob 
     620    mainPIL     <- compile main 
    623621    globPIR     <- runTransGlob tenv globPIL :: Eval [Decl] 
    624622    mainPIR     <- runTransMain tenv mainPIL :: Eval [Stmt]