Changeset 6248 for src/Pugs/Compile.hs

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 modified

Legend:

Unmodified
Added
Removed

  • 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