| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Koneko.Data
Description
>>>:set -XOverloadedStrings>>>import Data.Maybe>>>id = fromJust . ident; q = KQuot . id
>>>nilnil>>>false#f>>>true#t>>>int 4242>>>float (-1.23)-1.23>>>str "I like 猫s""I like 猫s">>>kwd "foo":foo>>>pair (Kwd "answer") $ int 42:answer 42 =>>>>list [int 42, kwd "foo"]( 42 :foo )>>>KIdent $ id "foo"foo>>>q "foo"'foo>>>block [id "x", id "y"] [q "y", q "x"] Nothing[ x y . 'y 'x ]
... TODO ...
Synopsis
- type Identifier = Text
- type Module = ModuleLookupTable
- type Evaluator = Context -> Stack -> IO Stack
- type Args = [(Identifier, KValue)]
- data KException
- = ParseError !String
- | EvalUnexpected !String
- | EvalScopelessBlock
- | ModuleNameError !String
- | ModuleLoadError !String
- | NameError !String
- | StackUnderflow
- | Expected !EExpected
- | MultiMatchFailed !String !String
- | UncomparableType !String
- | UncomparableTypes !String !String
- | UncallableType !String
- | UnapplicableType !String !String
- | UnknownField !String !String
- | EmptyList !String
- | IndexError !String !String
- | KeyError !String !String
- | RangeError !String
- | DivideByZero
- | InvalidRx !String
- | Fail !String
- | NotImplemented !String
- stackExpected :: Either String KValue -> String -> KException
- applyMissing :: Bool -> KException
- expected :: String -> KException
- unexpected :: String -> KException
- exceptionInfo :: KException -> [String]
- newtype Kwd = Kwd {
- unKwd :: Identifier
- data Ident
- unIdent :: Ident -> Identifier
- ident :: Identifier -> Maybe Ident
- data Pair = Pair {}
- newtype List = List {}
- newtype Dict = Dict {
- unDict :: DictTable
- data Block = Block {}
- data Builtin = Builtin {}
- data Multi = Multi {
- mltArity :: Int
- mltName :: Identifier
- mltTable :: MultiTable
- data RecordT = RecordT {
- recName :: Identifier
- recFields :: [Identifier]
- data Record
- recType :: Record -> RecordT
- recValues :: Record -> [KValue]
- record :: RecordT -> [KValue] -> Either KException Record
- data Thunk
- runThunk :: Thunk -> IO KValue
- thunk :: IO KValue -> IO Thunk
- data Scope = Scope {
- modName :: Identifier
- table :: ScopeLookupTable
- data Context
- ctxScope :: Context -> Scope
- data KPrim
- data KValue
- data KType
- type Stack = [KValue]
- freeVars :: [KValue] -> HashSet Identifier
- class Cmp a where
- escapeFrom :: [Text]
- escapeTo :: [Text]
- class ToVal a
- toVal :: ToVal a => a -> KValue
- class FromVal a
- fromVal :: FromVal a => KValue -> Either KException a
- toVals :: ToVal a => [a] -> [KValue]
- fromVals :: FromVal a => [KValue] -> Either KException [a]
- maybeToVal :: ToVal a => KValue -> Maybe a -> KValue
- eitherToVal :: ToVal a => KValue -> Either e a -> KValue
- toJSON :: KValue -> Either KException Text
- fromJSON :: Text -> Either KException KValue
- emptyStack :: Stack
- push' :: Stack -> KValue -> Stack
- push :: ToVal a => Stack -> a -> Stack
- rpush :: ToVal a => Stack -> [a] -> IO Stack
- rpush1 :: ToVal a => Stack -> a -> IO Stack
- pop_ :: Stack -> Either KException (KValue, Stack)
- pop :: FromVal a => Stack -> Either KException (a, Stack)
- pop2 :: (FromVal a, FromVal b) => Stack -> Either KException ((a, b), Stack)
- pop3 :: (FromVal a, FromVal b, FromVal c) => Stack -> Either KException ((a, b, c), Stack)
- pop4 :: (FromVal a, FromVal b, FromVal c, FromVal d) => Stack -> Either KException ((a, b, c, d), Stack)
- pop_' :: Stack -> IO (KValue, Stack)
- pop' :: FromVal a => Stack -> IO (a, Stack)
- pop2' :: (FromVal a, FromVal b) => Stack -> IO ((a, b), Stack)
- pop3' :: (FromVal a, FromVal b, FromVal c) => Stack -> IO ((a, b, c), Stack)
- pop4' :: (FromVal a, FromVal b, FromVal c, FromVal d) => Stack -> IO ((a, b, c, d), Stack)
- popN' :: FromVal a => Int -> Stack -> IO ([a], Stack)
- pop1push :: (FromVal a, ToVal b) => (a -> [b]) -> Evaluator
- pop2push :: (FromVal a, FromVal b, ToVal c) => (a -> b -> [c]) -> Evaluator
- pop1push1 :: (FromVal a, ToVal b) => (a -> b) -> Evaluator
- pop2push1 :: (FromVal a, FromVal b, ToVal c) => (a -> b -> c) -> Evaluator
- primModule :: Identifier
- bltnModule :: Identifier
- prldModule :: Identifier
- mainModule :: Identifier
- initMainContext :: IO Context
- initMain :: Context -> IO ()
- initModule :: Context -> Identifier -> IO ()
- forkContext :: Identifier -> Context -> IO Context
- forkScope :: Args -> Context -> Block -> IO Context
- defineIn :: Context -> Identifier -> KValue -> IO ()
- defineIn' :: Context -> Identifier -> Identifier -> KValue -> IO ()
- importIn :: Context -> Identifier -> IO ()
- importFromIn :: Context -> Identifier -> [Identifier] -> IO ()
- lookup :: Context -> Identifier -> IO (Maybe KValue)
- lookupModule' :: Context -> Identifier -> Identifier -> IO KValue
- moduleKeys :: Context -> Identifier -> IO [Identifier]
- moduleNames :: Context -> IO [Identifier]
- typeNames :: [Identifier]
- typeOfPrim :: KPrim -> KType
- typeOf :: KValue -> KType
- typeToKwd :: KType -> Kwd
- typeToStr :: IsString a => KType -> a
- typeAsStr :: IsString a => KValue -> a
- isNil :: KValue -> Bool
- isBool :: KValue -> Bool
- isInt :: KValue -> Bool
- isFloat :: KValue -> Bool
- isStr :: KValue -> Bool
- isKwd :: KValue -> Bool
- isPair :: KValue -> Bool
- isList :: KValue -> Bool
- isDict :: KValue -> Bool
- isIdent :: KValue -> Bool
- isQuot :: KValue -> Bool
- isBlock :: KValue -> Bool
- isBuiltin :: KValue -> Bool
- isMulti :: KValue -> Bool
- isRecordT :: KValue -> Bool
- isRecord :: KValue -> Bool
- isThunk :: KValue -> Bool
- isCallable :: KValue -> Bool
- isFunction :: KValue -> Bool
- nil :: KValue
- false :: KValue
- true :: KValue
- bool :: Bool -> KValue
- int :: Integer -> KValue
- float :: Double -> KValue
- str :: Text -> KValue
- kwd :: Text -> KValue
- pair :: ToVal a => Kwd -> a -> KValue
- list :: ToVal a => [a] -> KValue
- dict :: [Pair] -> KValue
- block :: [Ident] -> [KValue] -> Maybe Scope -> KValue
- dictLookup :: String -> Dict -> [Identifier] -> Either KException [KValue]
- mkPrim :: Identifier -> Evaluator -> Builtin
- mkBltn :: Identifier -> Evaluator -> Builtin
- defPrim :: Context -> Builtin -> IO ()
- defMulti :: Context -> Identifier -> [Identifier] -> Block -> IO ()
- truthy :: KValue -> Bool
- retOrThrow :: Either KException a -> IO a
- recordTypeSig :: RecordT -> Identifier
- underscored :: Text -> Text
- digitParams :: Block -> [Ident]
- unKwds :: [KValue] -> IO [Identifier]
- recordToPairs :: Record -> [Pair]
Documentation
type Identifier = Text Source #
type Args = [(Identifier, KValue)] Source #
data KException Source #
Constructors
| ParseError !String | |
| EvalUnexpected !String | unexpected value during eval |
| EvalScopelessBlock | block w/o scope during eval |
| ModuleNameError !String | |
| ModuleLoadError !String | |
| NameError !String | ident lookup failed |
| StackUnderflow | stack was empty |
| Expected !EExpected | |
| MultiMatchFailed !String !String | |
| UncomparableType !String | |
| UncomparableTypes !String !String | |
| UncallableType !String | |
| UnapplicableType !String !String | |
| UnknownField !String !String | |
| EmptyList !String | |
| IndexError !String !String | |
| KeyError !String !String | |
| RangeError !String | |
| DivideByZero | |
| InvalidRx !String | |
| Fail !String | |
| NotImplemented !String |
Instances
| Data KException Source # | |
Defined in Koneko.Data Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> KException -> c KException # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c KException # toConstr :: KException -> Constr # dataTypeOf :: KException -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c KException) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c KException) # gmapT :: (forall b. Data b => b -> b) -> KException -> KException # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> KException -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> KException -> r # gmapQ :: (forall d. Data d => d -> u) -> KException -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> KException -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> KException -> m KException # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> KException -> m KException # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> KException -> m KException # | |
| Show KException Source # | |
Defined in Koneko.Data Methods showsPrec :: Int -> KException -> ShowS # show :: KException -> String # showList :: [KException] -> ShowS # | |
| Exception KException Source # | |
Defined in Koneko.Data Methods toException :: KException -> SomeException # fromException :: SomeException -> Maybe KException # displayException :: KException -> String # | |
stackExpected :: Either String KValue -> String -> KException Source #
applyMissing :: Bool -> KException Source #
expected :: String -> KException Source #
unexpected :: String -> KException Source #
exceptionInfo :: KException -> [String] Source #
Constructors
| Kwd | |
Fields
| |
Instances
| Eq Kwd Source # | |
| Ord Kwd Source # | |
| Show Kwd Source # | |
| Generic Kwd Source # | |
| NFData Kwd Source # | |
Defined in Koneko.Data | |
| FromVal Kwd Source # | |
Defined in Koneko.Data | |
| ToVal Kwd Source # | |
| type Rep Kwd Source # | |
Defined in Koneko.Data type Rep Kwd = D1 ('MetaData "Kwd" "Koneko.Data" "koneko-0.0.2-83yCJUTvCgkNrPx5HFN9s" 'True) (C1 ('MetaCons "Kwd" 'PrefixI 'True) (S1 ('MetaSel ('Just "unKwd") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Identifier))) | |
Instances
| Eq Ident Source # | |
| Ord Ident Source # | |
| Show Ident Source # | |
| Generic Ident Source # | |
| NFData Ident Source # | |
Defined in Koneko.Data | |
| type Rep Ident Source # | |
Defined in Koneko.Data type Rep Ident = D1 ('MetaData "Ident" "Koneko.Data" "koneko-0.0.2-83yCJUTvCgkNrPx5HFN9s" 'True) (C1 ('MetaCons "Ident_" 'PrefixI 'True) (S1 ('MetaSel ('Just "unIdent") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Identifier))) | |
unIdent :: Ident -> Identifier Source #
Instances
| Eq Pair Source # | |
| Ord Pair Source # | |
| Show Pair Source # | |
| Generic Pair Source # | |
| NFData Pair Source # | |
Defined in Koneko.Data | |
| FromVal Pair Source # | |
Defined in Koneko.Data | |
| ToVal Pair Source # | |
| ToVal [Pair] Source # | |
| type Rep Pair Source # | |
Defined in Koneko.Data type Rep Pair = D1 ('MetaData "Pair" "Koneko.Data" "koneko-0.0.2-83yCJUTvCgkNrPx5HFN9s" 'False) (C1 ('MetaCons "Pair" 'PrefixI 'True) (S1 ('MetaSel ('Just "key") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Kwd) :*: S1 ('MetaSel ('Just "value") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 KValue))) | |
Instances
| Eq Block Source # | |
| Ord Block Source # | |
| Show Block Source # | |
| Generic Block Source # | |
| NFData Block Source # | |
Defined in Koneko.Data | |
| FromVal Block Source # | |
Defined in Koneko.Data | |
| ToVal Block Source # | |
| type Rep Block Source # | |
Defined in Koneko.Data type Rep Block = D1 ('MetaData "Block" "Koneko.Data" "koneko-0.0.2-83yCJUTvCgkNrPx5HFN9s" 'False) (C1 ('MetaCons "Block" 'PrefixI 'True) (S1 ('MetaSel ('Just "blkParams") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Ident]) :*: (S1 ('MetaSel ('Just "blkCode") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [KValue]) :*: S1 ('MetaSel ('Just "blkScope") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Scope))))) | |
Constructors
| RecordT | |
Fields
| |
Instances
| Eq RecordT Source # | |
| Ord RecordT Source # | |
| Show RecordT Source # | |
| Generic RecordT Source # | |
| NFData RecordT Source # | |
Defined in Koneko.Data | |
| FromVal RecordT Source # | |
Defined in Koneko.Data | |
| type Rep RecordT Source # | |
Defined in Koneko.Data type Rep RecordT = D1 ('MetaData "RecordT" "Koneko.Data" "koneko-0.0.2-83yCJUTvCgkNrPx5HFN9s" 'False) (C1 ('MetaCons "RecordT" 'PrefixI 'True) (S1 ('MetaSel ('Just "recName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Identifier) :*: S1 ('MetaSel ('Just "recFields") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Identifier]))) | |
Instances
| Eq Record Source # | |
| Ord Record Source # | |
| Show Record Source # | |
| Generic Record Source # | |
| NFData Record Source # | |
Defined in Koneko.Data | |
| FromVal Record Source # | |
Defined in Koneko.Data | |
| type Rep Record Source # | |
Defined in Koneko.Data type Rep Record = D1 ('MetaData "Record" "Koneko.Data" "koneko-0.0.2-83yCJUTvCgkNrPx5HFN9s" 'False) (C1 ('MetaCons "Record" 'PrefixI 'True) (S1 ('MetaSel ('Just "recType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RecordT) :*: S1 ('MetaSel ('Just "recValues") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [KValue]))) | |
Constructors
| Scope | |
Fields
| |
Instances
Constructors
| KPrim KPrim | |
| KPair Pair | |
| KList List | |
| KDict Dict | |
| KIdent Ident | |
| KQuot Ident | |
| KBlock Block | |
| KBuiltin Builtin | |
| KMulti Multi | |
| KRecordT RecordT | |
| KRecord Record | |
| KThunk Thunk |
Instances
Constructors
| TNil | |
| TBool | |
| TInt | |
| TFloat | |
| TStr | |
| TKwd | |
| TPair | |
| TList | |
| TDict | |
| TIdent | |
| TQuot | |
| TBlock | |
| TBuiltin | |
| TMulti | |
| TRecordT | |
| TRecord | |
| TThunk |
Instances
escapeFrom :: [Text] Source #
Minimal complete definition
Instances
| ToVal Bool Source # | |
| ToVal Double Source # | |
| ToVal Integer Source # | |
| ToVal () Source # | |
Defined in Koneko.Data | |
| ToVal Text Source # | |
| ToVal KValue Source # | |
| ToVal Builtin Source # | |
| ToVal Block Source # | |
| ToVal Dict Source # | |
| ToVal Pair Source # | |
| ToVal Kwd Source # | |
| ToVal [KValue] Source # | |
| ToVal [Pair] Source # | |
| ToVal a => ToVal (Maybe a) Source # | |
| ToVal a => ToVal (Either e a) Source # | |
Minimal complete definition
Instances
| FromVal Bool Source # | |
Defined in Koneko.Data | |
| FromVal Double Source # | |
Defined in Koneko.Data | |
| FromVal Integer Source # | |
Defined in Koneko.Data | |
| FromVal () Source # | |
Defined in Koneko.Data | |
| FromVal Text Source # | |
Defined in Koneko.Data | |
| FromVal KValue Source # | |
Defined in Koneko.Data | |
| FromVal Record Source # | |
Defined in Koneko.Data | |
| FromVal RecordT Source # | |
Defined in Koneko.Data | |
| FromVal Block Source # | |
Defined in Koneko.Data | |
| FromVal Dict Source # | |
Defined in Koneko.Data | |
| FromVal Pair Source # | |
Defined in Koneko.Data | |
| FromVal Kwd Source # | |
Defined in Koneko.Data | |
| FromVal [KValue] Source # | |
Defined in Koneko.Data | |
| FromVal a => FromVal (Maybe a) Source # | |
Defined in Koneko.Data | |
| (FromVal a, FromVal b) => FromVal (Either a b) Source # | |
Defined in Koneko.Data | |
emptyStack :: Stack Source #
pop2 :: (FromVal a, FromVal b) => Stack -> Either KException ((a, b), Stack) Source #
NB: returns popped items in "reverse" order
>>>s = emptyStack `push` 1 `push` 2>>>fst <$> pop' s :: IO Integer2>>>fst <$> pop2' s :: IO (Integer, Integer)(1,2)
stack: ... 1 2 <- top
pop3 :: (FromVal a, FromVal b, FromVal c) => Stack -> Either KException ((a, b, c), Stack) Source #
NB: returns popped items in "reverse" order
>>>s = emptyStack `push` 1 `push` 2 `push` 3>>>fst <$> pop3' s :: IO (Integer, Integer, Integer)(1,2,3)
stack: ... 1 2 3 <- top
pop4 :: (FromVal a, FromVal b, FromVal c, FromVal d) => Stack -> Either KException ((a, b, c, d), Stack) Source #
initModule :: Context -> Identifier -> IO () Source #
forkContext :: Identifier -> Context -> IO Context Source #
defineIn' :: Context -> Identifier -> Identifier -> KValue -> IO () Source #
importFromIn :: Context -> Identifier -> [Identifier] -> IO () Source #
lookupModule' :: Context -> Identifier -> Identifier -> IO KValue Source #
moduleKeys :: Context -> Identifier -> IO [Identifier] Source #
moduleNames :: Context -> IO [Identifier] Source #
typeNames :: [Identifier] Source #
typeOfPrim :: KPrim -> KType Source #
isCallable :: KValue -> Bool Source #
isFunction :: KValue -> Bool Source #
dictLookup :: String -> Dict -> [Identifier] -> Either KException [KValue] Source #
defMulti :: Context -> Identifier -> [Identifier] -> Block -> IO () Source #
retOrThrow :: Either KException a -> IO a Source #
recordTypeSig :: RecordT -> Identifier Source #
underscored :: Text -> Text Source #
digitParams :: Block -> [Ident] Source #
recordToPairs :: Record -> [Pair] Source #