Changeset 26 for src/AST.hs

Show
Ignore:
Timestamp:
02/14/05 06:02:18 (4 years ago)
Author:
autrijus
svk:copy_cache_prev:
1041
Message:

* snapshot during monadic refactoring

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • src/AST.hs

    r25 r26  
    1818type Ident = String 
    1919 
    20 class Context n where 
     20class Value n where 
    2121    vCast :: Val -> n 
    2222    vCast (VRef v)      = vCast v 
    … …  
    3131    fmapVal f = castV . f . vCast 
    3232 
    33 instance Context (Val, Val) where 
     33instance Value (Val, Val) where 
    3434    castV (x, y)        = VPair x y 
    3535    vCast (VPair x y)   = (x, y) 
    … …  
    3939        other   -> error $ "cannot cast into (Val, Val): " ++ (show v) 
    4040 
    41 instance Context VHash where 
     41instance Value VHash where 
    4242    castV = VHash 
    4343    vCast x = MkHash $ listToFM (map vCast $ vCast x)  
    4444 
    45 instance Context VSub where 
     45instance Value VSub where 
    4646    castV = VSub 
    4747    doCast (VSub b) = b 
    4848 
    49 instance Context VBool where 
     49instance Value VBool where 
    5050    castV = VBool 
    5151    doCast (VJunc j)   = juncToBool j 
    … …  
    7070    = (1 ==) . length . filter vCast $ setToList vs 
    7171 
    72 instance Context VInt where 
     72instance Value VInt where 
    7373    castV = VInt 
    7474    doCast (VInt i)     = i 
    … …  
    7878    doCast x            = round (vCast x :: VNum) 
    7979 
    80 instance Context VRat where 
     80instance Value VRat where 
    8181    castV = VRat 
    8282    doCast (VInt i)     = i % 1 
    … …  
    8484    doCast x            = approxRational (vCast x :: VNum) 1 
    8585 
    86 instance Context VNum where 
     86instance Value VNum where 
    8787    castV = VNum 
    8888    doCast VUndef       = 0 
    … …  
    9797    doCast x            = error $ "cannot cast: " ++ (show x) 
    9898 
    99 instance Context VComplex where 
     99instance Value VComplex where 
    100100    castV = VComplex 
    101101    doCast x            = (vCast x :: VNum) :+ 0 
    102102 
    103 instance Context VStr where 
     103instance Value VStr where 
    104104    castV = VStr 
    105105    vCast VUndef        = "" 
    … …  
    121121    str = show x  
    122122 
    123 instance Context VArray where 
     123instance Value VArray where 
    124124    castV = VArray 
    125125    vCast x = MkArray (vCast x)  
    126126 
    127127{- 
    128 instance Context VJunc where 
     128instance Value VJunc where 
    129129    castV = JAny . castV 
    130130    vCast x = JAny $ mkSet (vCast x) 
    131131-} 
    132132 
    133 instance Context VList where 
     133instance Value VList where 
    134134    castV = VList 
    135135    vCast (VList l)     = l 
    … …  
    139139    vCast v             = [v] 
    140140 
    141 instance Context (Maybe a) where 
     141instance Value (Maybe a) where 
    142142    vCast VUndef        = Nothing 
    143143    vCast _             = Just undefined 
    144144 
    145 instance Context Int   where doCast = intCast 
    146 instance Context Word  where doCast = intCast 
    147 instance Context Word8 where doCast = intCast 
    148 instance Context [Word8] where doCast = map (toEnum . ord) . vCast 
     145instance Value Int   where doCast = intCast 
     146instance Value Word  where doCast = intCast 
     147instance Value Word8 where doCast = intCast 
     148instance Value [Word8] where doCast = map (toEnum . ord) . vCast 
    149149 
    150150type VScalar = Val 
    151151-- type VJunc = Set Val 
    152152 
    153 instance Context VScalar where 
     153instance Value VScalar where 
    154154    vCast = id 
    155155    castV = id 
    … …  
    239239    , subName       :: String 
    240240    , subType       :: SubType 
    241     , subPad        :: Symbols 
     241    , subPad        :: Pad 
    242242    , subAssoc      :: String 
    243243    , subParams     :: Params 
    … …  
    257257-} 
    258258 
    259 instance Ord ([Val] -> StateEnv Val) where 
    260     compare _ _ = LT 
    261259instance (Ord a) => Ord (Set a) where 
    262260    compare x y = compare (setToList x) (setToList y) 
    … …  
    272270    | Syn String [Exp] 
    273271    | Sym Scope Var 
    274     | Prim ([Val] -> StateEnv Val) 
     272    | Prim ([Val] -> Eval Val) 
    275273    | Val Val 
    276274    | Var Var SourcePos 
    … …  
    326324defaultScalarParam  = buildParam "" "*" "$_" (Val VUndef) 
    327325 
    328 -- The eval monad! 
    329 type StateEnv a = State Env a 
    330  
    331326data Env = Env { envContext :: Cxt 
    332                , envPad     :: Symbols 
     327               , envPad     :: Pad 
    333328               , envClasses :: ClassTree 
    334329               , envEval    :: Exp -> Eval Val 
    … …  
    339334               } deriving (Show, Eq) 
    340335 
    341 type Symbols = [Symbol] 
     336type Pad = [Symbol] 
    342337data Symbol = Symbol { symScope :: Scope 
    343338                     , symName  :: String