Changeset 6248

Show
Ignore:
Timestamp:
08/14/05 17:32:14 (3 years ago)
Author:
autrijus
svk:copy_cache_prev:
8452
Message:

* -CBinary - dump PIL1 tree as opaque GhcBinary? file for fast loading.

Files:
1 added
12 modified

Legend:

Unmodified
Added
Removed

  • src/DrIFT/Binary.hs

    r6243 r6248  
    1 {-# OPTIONS -fallow-overlapping-instances #-} 
     1{-# OPTIONS_GHC -fglasgow-exts -w #-} 
    22-- 
    33-- (c) The University of Glasgow 2002 
    … …  
    4242   ByteArray(..), 
    4343   getByteArray, 
    44    putByteArray 
     44   putByteArray, 
    4545 
    4646   --getBinFileWithDict,        -- :: Binary a => FilePath -> IO a 
    … …  
    4949  ) where 
    5050 
    51  
    52 --import FastString 
    53 import FastMutInt 
    5451 
    5552import Data.Array.IO 
    … …  
    6057import Data.IORef 
    6158import Data.Char                ( ord, chr ) 
    62 import Data.Array.Base          ( unsafeRead, unsafeWrite ) 
    6359import Control.Monad            ( when ) 
    6460import Control.Exception        ( throwDyn ) 
    … …  
    7167import GHC.Word                 ( Word8(..) ) 
    7268import System.IO                ( openBinaryFile ) 
    73 import PackedString 
     69import UTF8.PackedString 
    7470--import Atom 
    7571import Time 
    … …  
    7773import Data.Array.IArray 
    7874import Data.Array.Base 
     75import Foreign.Storable 
     76import Control.Concurrent.STM 
    7977 
    8078 
    … …  
    711709    put_ bh a = put_ bh (toPackedString a) 
    712710-}         
     711 
     712sSIZEOF_HSINT = sizeOf (undefined :: Int) 
     713 
     714data FastMutInt = FastMutInt (MutableByteArray# RealWorld) 
     715 
     716newFastMutInt :: IO FastMutInt 
     717newFastMutInt = IO $ \s -> 
     718  case newByteArray# size s of { (# s, arr #) -> 
     719  (# s, FastMutInt arr #) } 
     720  where I# size = sSIZEOF_HSINT 
     721 
     722{-# INLINE readFastMutInt  #-} 
     723readFastMutInt :: FastMutInt -> IO Int 
     724readFastMutInt (FastMutInt arr) = IO $ \s -> 
     725  case readIntArray# arr 0# s of { (# s, i #) -> 
     726  (# s, I# i #) } 
     727 
     728{-# INLINE writeFastMutInt  #-} 
     729writeFastMutInt :: FastMutInt -> Int -> IO () 
     730writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s -> 
     731  case writeIntArray# arr 0# i s of { s -> 
     732  (# s, () #) } 
     733 
     734---------------------------------------------------------------------------- 
     735-- Pugs Additions 
     736 
     737instance Binary Double where 
     738    put_ bh n = put_ bh (decodeFloat n) 
     739    get  bh   = fmap (uncurry encodeFloat) (get bh) 
     740 
     741instance Binary a => Binary (TVar a) where 
     742    put_ bh v = put_ bh =<< (atomically $ readTVar v) 
     743    get  bh   = atomically . newTVar =<< get bh 
     744 
     745instance Binary a => Binary (IORef a) where 
     746    put_ bh v = put_ bh =<< readIORef v 
     747    get  bh   = newIORef =<< get bh 
     748 

  • src/DrIFT/Perl5.hs

    r6240 r6248  
    1 {-# OPTIONS_GHC -fglasgow-exts -funbox-strict-fields -fallow-overlapping-instances #-} 
     1{-# OPTIONS_GHC -fglasgow-exts -funbox-strict-fields -fallow-overlapping-instances -fallow-undecidable-instances #-} 
    22 
    33module DrIFT.Perl5 where 
    44import Data.Ratio 
    55import Data.List (intersperse) 
     6import Control.Concurrent.STM 
    67 
    78type Perl5Class = String 
    … …  
    6869    showPerl5 (x, y, z) = showP5Array [showPerl5 x, showPerl5 y, showPerl5 z] 
    6970 
     71instance (Show (TVar a)) => Perl5 (TVar a) where 
     72    showPerl5 _ = "(warn '<ref>')" 

  • src/Pugs/CodeGen.hs

    r6240 r6248  
    1616import Pugs.CodeGen.PIR (genPIR) 
    1717import Pugs.CodeGen.Perl5 (genPerl5) 
     18import Pugs.CodeGen.Binary (genBinary) 
    1819import Pugs.Compile.Pugs (genPugs) 
    1920import Pugs.Compile.Haskell (genGHC) 
    … …  
    3334    , ("Perl5",       genPerl5) 
    3435    , ("Pugs",        genPugs) 
     36    , ("Binary",      genBinary) 
    3537--  , ("Xml",         genXML) 
    3638    ] 

  • src/Pugs/CodeGen/PIL.hs

    r6229 r6248  
    55import Pugs.Internals 
    66import Pugs.AST 
     7import Pugs.PIL1 
    78import Pugs.Compile 
    89 
    910genPIL :: Eval Val 
    1011genPIL = do 
    11     glob        <- askGlobal 
    12     main        <- asks envBody 
    13     globPIL     <- compile glob :: Eval [PIL_Decl] 
    14     mainPIL     <- compile main :: Eval PIL_Stmts 
     12    penv <- compile () 
    1513    return . VStr . unlines $ 
    1614        [ "PIL_Environment" 
    17         , "    { pilMain = (" ++ show mainPIL ++ ")" 
    18         , "    , pilGlob = (" ++ show globPIL ++ ")" 
     15        , "    { pilMain = (" ++ show (pilMain penv) ++ ")" 
     16        , "    , pilGlob = (" ++ show (pilGlob penv) ++ ")" 
    1917        , "    }" 
    2018        ] 

  • src/Pugs/CodeGen/PIR.hs

    r6229 r6248  
    1919import Pugs.Types 
    2020import Pugs.Eval.Var 
     21import Pugs.PIL1 
    2122import Emit.PIR 
    2223import Pugs.Pretty 
    … …  
    338339    local (\env -> env{ envDebug = Nothing }) $ do 
    339340        opEval style "<prelude-pir>" preludeStr 
    340     glob        <- askGlobal 
    341     main        <- asks envBody 
    342     globPIL     <- compile glob 
    343     mainPIL     <- compile main 
    344     globPIR     <- runCodeGenGlob tenv globPIL 
    345     mainPIR     <- runCodeGenMain tenv mainPIL 
     341    penv        <- compile () 
     342    globPIR     <- runCodeGenGlob tenv (pilGlob penv) 
     343    mainPIR     <- runCodeGenMain tenv (pilMain penv) 
    346344    libs        <- liftIO $ getLibs 
    347345    return . VStr . unlines $ 
    … …  
    385383            , InsNew tempPMC PerlScalar 
    386384            , "store_global"    .- [lit "$_", tempPMC] 
    387             ]) ++ [ StmtRaw (text (name ++ "()")) | PSub name@('_':'_':_) _ _ _ <- globPIL] ++ 
     385            ]) ++ [ StmtRaw (text (name ++ "()")) | PSub name@('_':'_':_) _ _ _ <- pilGlob penv ] ++ 
    388386            [ StmtRaw (text "main()") 
    389387            , StmtIns $ tempPMC  <-- "find_global" $ [lit "Perl6::Internals", lit "&exit"] 

  • src/Pugs/CodeGen/Perl5.hs

    r6236 r6248  
    66import Pugs.AST 
    77import Pugs.Compile 
     8import Pugs.PIL1 
    89import DrIFT.Perl5 
    910 
    1011genPerl5 :: Eval Val 
    1112genPerl5 = do 
    12     glob        <- askGlobal 
    13     main        <- asks envBody 
    14     globPIL     <- compile glob :: Eval [PIL_Decl] 
    15     mainPIL     <- compile main :: Eval PIL_Stmts 
     13    penv <- compile () 
    1614    return . VStr . unlines $ 
    1715        [ "bless({" 
    18         , "    pilMain => " ++ showPerl5 mainPIL ++ "," 
    19         , "    pilGlob => " ++ showPerl5 globPIL 
     16        , "    pilMain => " ++ showPerl5 (pilMain penv) ++ "," 
     17        , "    pilGlob => " ++ showPerl5 (pilGlob penv) 
    2018        , "} => 'PIL::Environment')" 
    2119        ] 

  • src/Pugs/CodeGen/XML.hs

    r6239 r6248  
    1111genXML :: Eval Val 
    1212genXML = do 
    13     glob        <- askGlobal 
    14     main        <- asks envBody 
    15     globPIL     <- compile glob :: Eval [PIL_Decl] 
    16     mainPIL     <- compile main :: Eval PIL_Stmts 
    17     return . VStr . showXml $ PIL_Environment globPIL mainPIL 
     13    penv <- compile () :: Eval PIL_Environment 
     14    return $ VStr (showXml penv) 

  • src/Pugs/Compile.hs

    r6230 r6248  
    4949 
    5050-- Compile instances 
    51 instance Compile (Var, [(TVar Bool, TVar VRef)]) (PIL_Decl) where 
     51instance Compile () PIL_Environment where 
     52    compile _ = do 
     53        glob    <- askGlobal 
     54        main    <- asks envBody 
     55        globPIL <- compile glob 
     56        mainPIL <- compile main 
     57        return $ PIL_Environment globPIL mainPIL 
     58 
     59instance Compile (Var, [(TVar Bool, TVar VRef)]) PIL_Decl where 
    5260    compile = compError 
    5361 
    … …  
    126134        return [PSub name (subType vsub) paramsC bodyC] 
    127135 
    128 instance Compile (String, [(TVar Bool, TVar VRef)]) (PIL_Expr) where 
     136instance Compile (String, [(TVar Bool, TVar VRef)]) PIL_Expr where 
    129137    compile (name, _) = return $ PRawName name 
    130138 
    131 instance Compile Exp (PIL_Stmts) where 
     139instance Compile Exp PIL_Stmts where 
    132140    compile (Pos _ rest) = compile rest -- fmap (PPos pos rest) $ compile rest 
    133141    compile (Cxt cxt rest) = enter cxt $ compile rest 
    … …  
    149157    enter cxt = local (\e -> e{ envContext = cxt }) 
    150158 
    151 compileStmts :: Exp -> Comp (PIL_Stmts) 
     159compileStmts :: Exp -> Comp PIL_Stmts 
    152160compileStmts exp = case exp of 
    153161    Stmts this Noop -> do 
    … …  
    170178    _           -> compile (Stmts exp Noop) 
    171179 
    172 instance Compile Val (PIL_Stmt) where 
     180instance Compile Val PIL_Stmt where 
    173181    compile = fmap PStmt . compile . Val 
    174182 
    175 instance Compile Val (PIL_Expr) where 
     183instance Compile Val PIL_Expr where 
    176184    compile = compile . Val 
    177185 
    178 instance Compile Exp (PIL_Stmt) where 
     186instance Compile Exp PIL_Stmt where 
    179187    compile (Pos pos rest) = fmap (PPos pos rest) $ compile rest 
    180188    compile (Cxt cxt rest) = enter cxt $ compile rest 
    … …  
    250258    compile x = compError x 
    251259 
    252 instance Compile Exp (PIL_LValue) where 
     260instance Compile Exp PIL_LValue where 
    253261    compile (Pos _ rest) = compile rest -- fmap (PPos pos rest) $ compile rest 
    254262    compile (Cxt cxt rest) = enter cxt $ compile rest 
    … …  
    311319    compile exp = compError exp 
    312320 
    313 compLoop :: Exp -> Comp (PIL_Stmt) 
     321compLoop :: Exp -> Comp PIL_Stmt 
    314322compLoop (Syn name [cond, body]) = do 
    315323    cxt     <- askTCxt 
    … …  
    323331    appropriate function call (@&statement_control:if@ or 
    324332    @&statement_control:unless@). -} 
    325 compConditional :: Exp -> Comp (PIL_LValue) 
     333compConditional :: Exp -> Comp PIL_LValue 
    326334compConditional (Syn name exps) = do 
    327335    [condC, trueC, falseC] <- compile exps 
    … …  
    332340 
    333341{-| Compiles various 'Exp's to 'PIL_Expr's. -} 
    334 instance Compile Exp (PIL_Expr) where 
     342instance Compile Exp PIL_Expr where 
    335343    compile (Pos _ rest) = compile rest -- fmap (PPos pos rest) $ compile rest 
    336344    compile (Cxt cxt rest) = enter cxt $ compile rest 
    … …  
    363371 
    364372{-| Compiles a 'Val' to a 'PIL_Literal'. -} 
    365 instance Compile Val (PIL_Literal) where 
     373instance Compile Val PIL_Literal where 
    366374    compile val = return $ PVal val 
    367375 

  • src/Pugs/Embed/Parrot.hsc

    r5963 r6248  
    4949evalParrot str = do 
    5050    tmp         <- getTemporaryDirectory 
    51     (file, fh)  <- openTempFile tmp "pugs.imc" 
     51    (file, fh)  <- openTempFile tmp "pugs.pir" 
    5252    hPutStr fh str 
    5353    hClose fh 

  • src/Pugs/PIL1.hs

    r6240 r6248  
    1 {-# OPTIONS_GHC -fglasgow-exts -funbox-strict-fields -fallow-overlapping-instances -fno-warn-orphans #-} 
     1{-# OPTIONS_GHC -fglasgow-exts -funbox-strict-fields -fallow-overlapping-instances -fno-warn-orphans -fno-warn-incomplete-patterns #-} 
    22 
    33module Pugs.PIL1 ( 
    … …  
    88) where 
    99import Pugs.AST hiding (Prim) 
    10 import Pugs.Internals 
     10import Pugs.Internals hiding (get, put) 
    1111import Pugs.Types 
    1212import Emit.PIR 
    1313import DrIFT.Perl5 
     14import DrIFT.Binary 
    1415 
    1516-- import DrIFT.XML 
    1617-- {-! global : Haskell2Xml !-} 
    1718 
    18 {-! global : Perl5 !-} 
    19  
    20 instance (Typeable a) => Perl5 (TVar a) where 
    21     showPerl5 _ = "(warn '<ref>')" 
    22 instance Perl5 Exp where 
    23     showPerl5 _ = "(undef)" 
     19{-! global : GhcBinary, Perl5 !-} 
    2420 
    2521{-| 
    … …  
    3026 
    3127data PIL_Environment = PIL_Environment 
    32     { pilMain :: [PIL_Decl] 
    33     , pilGlob :: PIL_Stmts 
     28    { pilGlob :: [PIL_Decl] 
     29    , pilMain :: PIL_Stmts 
    3430    } 
    3531    deriving (Show, Eq, Ord, Typeable) 
    … …  
    116112------------------------------------------------------------------------ 
    117113 
     114instance Binary Exp where 
     115    put_ _ _ = return () 
     116    get  _   = return Noop 
     117instance Perl5 Exp where 
     118    showPerl5 _ = "(undef)" 
     119 
    118120{-* Generated by DrIFT : Look, but Don't Touch. *-} 
     121instance Binary PIL_Environment where 
     122    put_ bh (PIL_Environment aa ab) = do 
     123            put_ bh aa 
     124            put_ bh ab 
     125    get bh = do 
     126    aa <- get bh 
     127    ab <- get bh 
     128    return (PIL_Environment aa ab) 
     129 
    119130instance Perl5 PIL_Environment where 
    120131    showPerl5 (PIL_Environment aa ab) = 
    121132              showP5HashObj "PIL::Environment" 
    122               [("pilMain", showPerl5 aa) , ("pilGlob", showPerl5 ab)] 
     133              [("pilGlob", showPerl5 aa) , ("pilMain", showPerl5 ab)] 
     134 
     135instance Binary PIL_Stmts where 
     136    put_ bh PNil = do 
     137            putByte bh 0 
     138    put_ bh (PStmts aa ab) = do 
     139            putByte bh 1 
     140            put_ bh aa 
     141            put_ bh ab 
     142    put_ bh (PPad ac ad ae) = do 
     143            putByte bh 2 
     144            put_ bh ac 
     145            put_ bh ad 
     146            put_ bh ae 
     147    get bh = do 
     148            h <- getByte bh 
     149            case h of 
     150              0 -> do 
     151                    return PNil 
     152              1 -> do 
     153                    aa <- get bh 
     154                    ab <- get bh 
     155                    return (PStmts aa ab) 
     156              2 -> do 
     157                    ac <- get bh 
     158                    ad <- get bh 
     159                    ae <- get bh 
     160                    return (PPad ac ad ae) 
    123161 
    124162instance Perl5 PIL_Stmts where 
    … …  
    130168               ("pStmts", showPerl5 ac)] 
    131169 
     170instance Binary PIL_Stmt where 
     171    put_ bh PNoop = do 
     172            putByte bh 0 
     173    put_ bh (PStmt aa) = do 
     174            putByte bh 1 
     175            put_ bh aa 
     176    put_ bh (PPos ab ac ad) = do 
     177            putByte bh 2 
     178            put_ bh ab 
     179            put_ bh ac 
     180            put_ bh ad 
     181    get bh = do 
     182            h <- getByte bh 
     183            case h of 
     184              0 -> do 
     185                    return PNoop 
     186              1 -> do 
     187                    aa <- get bh 
     188                    return (PStmt aa) 
     189              2 -> do 
     190                    ab <- get bh 
     191                    ac <- get bh 
     192                    ad <- get bh 
     193                    return (PPos ab ac ad) 
     194 
    132195instance Perl5 PIL_Stmt where 
    133196    showPerl5 (PNoop) = showP5Class "PNoop" 
    … …  
    137200              [("pPos", showPerl5 aa) , ("pExp", showPerl5 ab) , 
    138201               ("pNode", showPerl5 ac)] 
     202 
     203instance Binary PIL_Expr where 
     204    put_ bh (PRawName aa) = do 
     205            putByte bh 0 
     206            put_ bh aa 
     207    put_ bh (PExp ab) = do 
     208            putByte bh 1 
     209            put_ bh ab 
     210    put_ bh (PLit ac) = do 
     211            putByte bh 2 
     212            put_ bh ac 
     213    put_ bh (PThunk ad) = do 
     214            putByte bh 3 
     215            put_ bh ad 
     216    put_ bh (PCode ae af ag) = do 
     217            putByte bh 4 
     218            put_ bh ae 
     219            put_ bh af 
     220            put_ bh ag 
     221    get bh = do 
     222            h <- getByte bh 
     223            case h of 
     224              0 -> do 
     225                    aa <- get bh 
     226                    return (PRawName aa) 
     227              1 -> do 
     228                    ab <- get bh 
     229                    return (PExp ab) 
     230              2 -> do 
     231                    ac <- get bh 
     232                    return (PLit ac) 
     233              3 -> do 
     234                    ad <- get bh 
     235                    return (PThunk ad) 
     236              4 -> do 
     237                    ae <- get bh 
     238                    af <- get bh 
     239                    ag <- get bh 
     240                    return (PCode ae af ag) 
    139241 
    140242instance Perl5 PIL_Expr where 
    … …  
    149251               ("pBody", showPerl5 ac)] 
    150252 
     253instance Binary PIL_Decl where 
     254    put_ bh (PSub aa ab ac ad) = do 
     255            put_ bh aa 
     256            put_ bh ab 
     257            put_ bh ac 
     258            put_ bh ad 
     259    get bh = do 
     260    aa <- get bh 
     261    ab <- get bh 
     262    ac <- get bh 
     263    ad <- get bh 
     264    return (PSub aa ab ac ad) 
     265 
    151266instance Perl5 PIL_Decl where 
    152267    showPerl5 (PSub aa ab ac ad) = showP5HashObj "PSub" 
    … …  
    154269               ("pSubParams", showPerl5 ac) , ("pSubBody", showPerl5 ad)] 
    155270 
     271instance Binary PIL_Literal where 
     272    put_ bh (PVal aa) = do 
     273            put_ bh aa 
     274    get bh = do 
     275    aa <- get bh 
     276    return (PVal aa) 
     277 
    156278instance Perl5 PIL_Literal where 
    157279    showPerl5 (PVal aa) = showP5HashObj "PVal" [("pVal", showPerl5 aa)] 
     280 
     281instance Binary PIL_LValue where 
     282    put_ bh (PVar aa) = do 
     283            putByte bh 0 
     284            put_ bh aa 
     285    put_ bh (PApp ab ac ad ae) = do 
     286            putByte bh 1 
     287            put_ bh ab 
     288            put_ bh ac 
     289            put_ bh ad 
     290            put_ bh ae 
     291    put_ bh (PAssign af ag) = do 
     292            putByte bh 2 
     293            put_ bh af 
     294            put_ bh ag 
     295    put_ bh (PBind ah ai) = do 
     296            putByte bh 3 
     297            put_ bh ah 
     298            put_ bh ai 
     299    get bh = do 
     300            h <- getByte bh 
     301            case h of 
     302              0 -> do 
     303                    aa <- get bh 
     304                    return (PVar aa) 
     305              1 -> do 
     306                    ab <- get bh 
     307                    ac <- get bh 
     308                    ad <- get bh 
     309                    ae <- get bh 
     310                    return (PApp ab ac ad ae) 
     311              2 -> do 
     312                    af <- get bh 
     313                    ag <- get bh 
     314                    return (PAssign af ag) 
     315              3 -> do 
     316                    ah <- get bh 
     317                    ai <- get bh 
     318                    return (PBind ah ai) 
    158319 
    159320instance Perl5 PIL_LValue where 
    … …  
    168329              [("pLHS", showPerl5 aa) , ("pRHS", showPerl5 ab)] 
    169330 
     331instance Binary TParam where 
     332    put_ bh (MkTParam aa ab) = do 
     333            put_ bh aa 
     334            put_ bh ab 
     335    get bh = do 
     336    aa <- get bh 
     337    ab <- get bh 
     338    return (MkTParam aa ab) 
     339 
    170340instance Perl5 TParam where 
    171341    showPerl5 (MkTParam aa ab) = showP5HashObj "MkTParam" 
    172342              [("tpParam", showPerl5 aa) , ("tpDefault", showPerl5 ab)] 
     343 
     344instance Binary TCxt where 
     345    put_ bh TCxtVoid = do 
     346            putByte bh 0 
     347    put_ bh (TCxtLValue aa) = do 
     348            putByte bh 1 
     349            put_ bh aa 
     350    put_ bh (TCxtItem ab) = do 
     351            putByte bh 2 
     352            put_ bh ab 
     353    put_ bh (TCxtSlurpy ac) = do 
     354            putByte bh 3 
     355            put_ bh ac 
     356    put_ bh (TTailCall ad) = do 
     357            putByte bh 4 
     358            put_ bh ad 
     359    get bh = do 
     360            h <- getByte bh 
     361            case h of 
     362              0 -> do 
     363                    return TCxtVoid 
     364              1 -> do 
     365                    aa <- get bh 
     366                    return (TCxtLValue aa) 
     367              2 -> do 
     368                    ab <- get bh 
     369                    return (TCxtItem ab) 
     370              3 -> do 
     371                    ac <- get bh 
     372                    return (TCxtSlurpy ac) 
     373              4 -> do 
     374                    ad <- get bh 
     375                    return (TTailCall ad) 
    173376 
    174377instance Perl5 TCxt where 
    … …  
    182385              [showPerl5 aa] 
    183386 
     387instance Binary TEnv where 
     388    put_ bh (MkTEnv aa ab ac ad ae) = do 
     389            put_ bh aa 
     390            put_ bh ab 
     391            put_ bh ac 
     392            put_ bh ad 
     393            put_ bh ae 
     394    get bh = do 
     395    aa <- get bh 
     396    ab <- get bh 
     397    ac <- get bh 
     398    ad <- get bh 
     399    ae <- get bh 
     400    return (MkTEnv aa ab ac ad ae) 
     401 
    184402instance Perl5 TEnv where 
    185403    showPerl5 (MkTEnv aa ab ac ad ae) = showP5HashObj "MkTEnv" 
    … …  
    187405               ("tCxt", showPerl5 ac) , ("tReg", showPerl5 ad) , 
    188406               ("tLabel", showPerl5 ae)] 
     407 
     408instance Binary Scope where 
     409    put_ bh SState = do 
     410            putByte bh 0 
     411    put_ bh SMy = do 
     412            putByte bh 1 
     413    put_ bh SOur = do 
     414            putByte bh 2 
     415    put_ bh SLet = do 
     416            putByte bh 3 
     417    put_ bh STemp = do 
     418            putByte bh 4 
     419    put_ bh SGlobal = do 
     420            putByte bh 5 
     421    get bh = do 
     422            h <- getByte bh 
     423            case h of 
     424              0 -> do 
     425                    return SState 
     426              1 -> do 
     427                    return SMy 
     428              2 -> do 
     429                    return SOur 
     430              3 -> do 
     431                    return SLet 
     432              4 -> do 
     433                    return STemp 
     434              5 -> do 
     435                    return SGlobal 
    189436