haskell/Types.hs

   1 module Types
   2 ( MalVal (..), IOThrows, Fn, Env, MetaData (..), Vect (..),
   3   keyValuePairs, throwStr, toList, keywordMagic)
   4 where
   5
   6 import Data.IORef (IORef)
   7 import qualified Data.Map as Map
   8 import Control.Monad.Except (ExceptT, throwError)
   9
  10
  11 -- Base Mal types --
  12 type Fn = [MalVal] -> IOThrows MalVal
  13
  14 -- Use type safety for unnamed components, without runtime penalty.
  15 newtype MetaData = MetaData MalVal
  16 newtype Vect     = Vect     Bool
  17
  18 data MalVal = Nil
  19             | MalBoolean  Bool
  20             | MalNumber   Int
  21             | MalString   String
  22             | MalSymbol   String
  23             | MalSeq      MetaData Vect [MalVal]
  24             | MalHashMap  MetaData (Map.Map String MalVal)
  25             | MalAtom     MetaData (IORef MalVal)
  26             | MalFunction {fn :: Fn,
  27                            f_ast :: MalVal,
  28                            f_params :: [String],
  29                            macro :: Bool,
  30                            meta :: MalVal}
  31
  32 keywordMagic :: Char
  33 keywordMagic = '\x029e'
  34
  35 _equal_Q :: MalVal -> MalVal -> Bool
  36 _equal_Q Nil Nil = True
  37 _equal_Q (MalBoolean a) (MalBoolean b) = a == b
  38 _equal_Q (MalNumber a) (MalNumber b) = a == b
  39 _equal_Q (MalString a) (MalString b) = a == b
  40 _equal_Q (MalSymbol a) (MalSymbol b) = a == b
  41 _equal_Q (MalSeq _ _ a) (MalSeq _ _ b) = a == b
  42 _equal_Q (MalHashMap _ a) (MalHashMap _ b) = a == b
  43 _equal_Q (MalAtom _ a) (MalAtom _ b) = a == b
  44 _equal_Q _ _ = False
  45
  46 instance Eq MalVal where
  47     x == y = _equal_Q x y
  48
  49
  50 --- Errors/Exceptions ---
  51
  52 type IOThrows = ExceptT MalVal IO
  53
  54 throwStr :: String -> IOThrows a
  55 throwStr = throwError . MalString
  56
  57 -- Env types --
  58 -- Note: Env functions are in Env module
  59 type Env = [IORef (Map.Map String MalVal)]
  60
  61 --  Convenient shortcuts for common situations.
  62
  63 toList :: [MalVal] -> MalVal
  64 toList = MalSeq (MetaData Nil) (Vect False)
  65
  66 keyValuePairs :: [MalVal] -> Maybe [(String, MalVal)]
  67 keyValuePairs []                      = pure []
  68 keyValuePairs (MalString k : v : kvs) = ((k, v) :) <$> keyValuePairs kvs
  69 keyValuePairs _ = Nothing