Show
Ignore:
Timestamp:
04/28/05 18:38:12 (4 years ago)
Author:
autrijus
svk:copy_cache_prev:
3914
Message:

* AST.hs-boot elimianted!

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • src/Pugs/Types/Code.hs

    r2221 r2441  
    1 {-# OPTIONS_GHC -fglasgow-exts #-} 
    21 
    3 module Pugs.Types.Code where 
     2class (Typeable a) => CodeClass a where 
     3    code_iType :: a -> Type 
     4    code_iType = const $ mkType "Code" 
     5    code_fetch    :: a -> Eval VCode 
     6    code_fetch a = code_assuming a [] [] 
     7    code_store    :: a -> VCode -> Eval () 
     8    code_assuming :: a -> [Exp] -> [Exp] -> Eval VCode 
     9    code_apply    :: a -> Eval Val 
     10    code_assoc    :: a -> VStr 
     11    code_params   :: a -> Params 
    412 
    5 import {-# SOURCE #-} Pugs.AST 
    6 import Pugs.Internals 
    7 import Pugs.Types 
     13instance CodeClass ICode where 
     14    code_iType c  = code_iType . unsafePerformSTM $ readTVar c 
     15    code_fetch    = liftSTM . readTVar 
     16    code_store    = (liftSTM .) . writeTVar 
     17    code_assuming c [] [] = code_fetch c 
     18    code_assuming _ _ _   = undefined 
     19    code_apply    = error "apply" 
     20    code_assoc c  = code_assoc . unsafePerformSTM $ readTVar c 
     21    code_params c = code_params . unsafePerformSTM $ readTVar c 
    822 
    9 class (Typeable a) => Class a where 
    10     iType :: a -> Type 
    11     iType = const $ mkType "Code" 
    12     fetch    :: a -> Eval VCode 
    13     fetch a = assuming a [] [] 
    14     store    :: a -> VCode -> Eval () 
    15     assuming :: a -> [Exp] -> [Exp] -> Eval VCode 
    16     apply    :: a -> Eval Val 
    17     assoc    :: a -> VStr 
    18     params   :: a -> Params 
     23instance CodeClass VCode where 
     24    -- XXX - subType should really just be a mkType itself 
     25    code_iType c  = case subType c of 
     26        SubBlock    -> mkType "Block" 
     27        SubRoutine  -> mkType "Sub" 
     28        SubPrim     -> mkType "Sub" 
     29        SubMethod   -> mkType "Method" 
     30    code_fetch    = return 
     31    code_store _ _= retConstError undef 
     32    code_assuming c [] [] = return c 
     33    code_assuming _ _ _   = error "assuming" 
     34    code_apply    = error "apply" 
     35    code_assoc    = subAssoc 
     36    code_params   = subParams 
     37