Changeset 5360

Show
Ignore:
Timestamp:
07/10/05 16:32:40 (4 years ago)
Author:
autrijus
svk:copy_cache_prev:
7349
Message:

* Lambdas and Camels, I present... precompiled Prelude!

Files:
5 modified

Legend:

Unmodified
Added
Removed

  • src/Main.hs

    r5266 r5360  
    127127userDefined (MkPad pad) = MkPad $ Map.filterWithKey doFilter pad 
    128128    where 
    129     doFilter "@*END" _      = True 
    130     doFilter (_:'*':_) _    = False 
    131     doFilter _ _            = True 
     129    doFilter key _ = not (key `elem` reserved) 
     130    reserved = words $ 
     131        "@*ARGS @*INC %*INC $*PUGS_HAS_HSPLUGINS $*EXECUTABLE_NAME " ++ 
     132        "$*PROGRAM_NAME $*PID $*UID $*EUID $*GID $*EGID @*CHECK @*INIT $*IN " ++ 
     133        "$*OUT $*ERR $*ARGS $!  $/ %*ENV $*CWD @=POD $=POD $?PUGS_VERSION " ++ 
     134        "$*OS &?BLOCK_EXIT %?CONFIG $*_ $*AUTOLOAD $*PACKAGE" 
    132135 
    133136repLoop :: IO () 

  • src/Pugs/Compile/Pugs.hs

    r5358 r5360  
    104104 
    105105instance Compile (String, [(TVar Bool, TVar VRef)]) where 
    106     compile ((_:'?':_), _) = return empty -- XXX - @?S etc; punt for now 
    107     compile ((_:'*':_), _) = return empty -- XXX - @*INIT etc; punt for now 
    108     compile ((_:'=':_), _) = return empty -- XXX - @=POS etc; punt for now 
     106    compile ((':':'*':_), _) = return empty -- XXX - :*Bool etc; punt for now 
    109107    compile (n, tvars) = do 
    110         tvarsC <- compile tvars 
    111         return $ prettyDo  
    112                 [ prettyBind "tvars" (text "sequence" `sep1` tvarsC) 
     108        tvarsC <- fmap (filter (not . isEmpty)) $ mapM compile tvars 
     109        if null tvarsC then return empty else do 
     110        return $ prettyDo  
     111                [ prettyBind "tvars" (text "sequence" `sep1` prettyList tvarsC) 
    113112                , text ("return (" ++ show n ++ ", tvars)") 
    114113                ] 
    … …  
    121120        freshC <- compile fresh 
    122121        tvarC  <- compile tvar 
     122        if isEmpty tvarC then return empty else do 
    123123        return $ prettyDo  
    124124                [ prettyBind "fresh" freshC 
    … …  
    136136        vref    <- liftSTM $ readTVar fresh 
    137137        vrefC   <- compile vref 
     138        if isEmpty vrefC then return empty else do 
    138139        return $ prettyDo 
    139140            [ prettyBind "vref" vrefC 
    … …  
    145146        vsub    <- code_fetch cv 
    146147        vsubC   <- compile vsub 
     148        if isEmpty vsubC then return empty else do 
    147149        return $ prettyDo 
    148150            [ prettyBind "vsub" vsubC 
    … …  
    152154        sv  <- scalar_fetch sv 
    153155        svC <- compile sv 
     156        if isEmpty svC then return empty else do 
    154157        return $ prettyDo 
    155158            [ prettyBind "sv" svC 
    … …  
    168171    compile x = return $ text "return" $+$ parens (text $ show x) 
    169172 
    170 -- This wants a total rewrite.  I strongly want Data.Generics at this point now. 
     173-- We need a compile VObject! 
    171174 
    172175-- Haddock can't cope with Template Haskell 
    173176instance Compile VCode where 
    174     compile MkCode{ subBody = Prim _ } = return $ text "return mkPrim" 
     177    -- compile MkCode{ subBody = Prim _ } = return $ text "return mkPrim" 
     178    compile MkCode{ subBody = Prim _ } = return empty 
    175179    compile code = do  
    176180        bodyC <- compile $ subBody code 

  • src/Pugs/PreludePC.hs-null

    r5140 r5360  
    77-} 
    88 
    9 initPreludePC :: Env -> IO () 
    10 initPreludePC = return $ liftIO $ return () 
     9initPreludePC :: Env -> IO Env 
     10initPreludePC = return 
    1111 

  • src/Pugs/Run.hs

    r5175 r5360  
    2525import Pugs.Eval 
    2626import Pugs.Prim 
    27 import Pugs.Prelude 
    2827import Pugs.Prim.Eval 
    2928import Pugs.Embed 
    30 --import Pugs.Prelude 
    3129import qualified Data.Map as Map 
    3230 
    … …  
    158156        initPerl5 "" (Just . VControl $ ControlEnv env{ envDebug = Nothing }) 
    159157        return () 
    160     -- XXX - entirely wrong -- will revert to the next line 
    161     initPrelude env 
    162     -- initPreludePC env              -- null in first pass 
    163     return env 
     158    initPreludePC env              -- null in first pass 
    164159    where 
    165160    hideInSafemode x = if safeMode then MkRef $ constScalar undef else x 
    166  
    167 {-# NOINLINE initPrelude #-} 
    168 initPrelude :: Env -> IO () 
    169 initPrelude env = do 
    170     if bypass then return () else do 
    171         -- Display the progress of loading the Prelude, but only in interactive 
    172         -- mode (similar to GHCi): 
    173         -- "Loading Prelude... done." 
    174         let dispProgress = (posName . envPos $ env) == "<interactive>" 
    175         when dispProgress $ putStr "Loading Prelude... " 
    176         runEvalIO env{envDebug = Nothing} $ opEval style "<prelude>" preludeStr 
    177         when dispProgress $ putStrLn "done." 
    178     where 
    179     style = MkEvalStyle{evalResult=EvalResultModule 
    180                        ,evalError =EvalErrorFatal} 
    181     bypass = case (unsafePerformIO $ getEnv "PUGS_BYPASS_PRELUDE") of 
    182         Nothing     -> False 
    183         Just ""     -> False 
    184         Just "0"    -> False 
    185         _           -> True 
    186161 
    187162initClassObjects :: [Type] -> ClassTree -> IO [STM (Pad -> Pad)] 

  • util/gen_prelude.pl

    r5243 r5360  
    6161 
    6262{-# NOINLINE initPreludePC #-} 
    63 initPreludePC :: Env -> IO () 
     63initPreludePC :: Env -> IO Env 
    6464initPreludePC env = do 
    65     if bypass then return () else do 
     65    if bypass then return env else do 
    6666        -- Display the progress of loading the Prelude, but only in interactive 
    6767        -- mode (similar to GHCi): 
    … …  
    7676        runEnv env{ envBody = ast, envGlobal = globRef, envDebug = Nothing } 
    7777        when dispProgress $ putStrLn "done." 
     78        return env{ envGlobal = globRef } 
    7879    where 
    7980    bypass = case (unsafePerformIO $ getEnv "PUGS_BYPASS_PRELUDE") of