{- |
Module      : Language.Scheme.Environments
Copyright   : Justin Ethier
Licence     : MIT (see LICENSE in the distribution)

Maintainer  : github.com/justinethier
Stability   : experimental
Portability : portable

-}

module Language.Scheme.Environments
    (
      primitives
    , ioPrimitives
    ) where
import Language.Scheme.Libraries
import Language.Scheme.Numerical
import Language.Scheme.Primitives
import Language.Scheme.Types
import Language.Scheme.Variables
import Control.Monad.Except
import qualified Data.Char
import System.IO

-- |Primitive functions that execute within the IO monad
ioPrimitives :: [(String, [LispVal] -> IOThrowsError LispVal)]
ioPrimitives :: [(String, [LispVal] -> IOThrowsError LispVal)]
ioPrimitives = [(String
"open-input-file", (String -> IOMode -> IO Handle)
-> IOMode -> [LispVal] -> IOThrowsError LispVal
makePort String -> IOMode -> IO Handle
openFile IOMode
ReadMode ),
                (String
"open-binary-input-file", (String -> IOMode -> IO Handle)
-> IOMode -> [LispVal] -> IOThrowsError LispVal
makePort String -> IOMode -> IO Handle
openBinaryFile IOMode
ReadMode),
                (String
"open-output-file", (String -> IOMode -> IO Handle)
-> IOMode -> [LispVal] -> IOThrowsError LispVal
makePort String -> IOMode -> IO Handle
openFile IOMode
WriteMode),
                (String
"open-binary-output-file", (String -> IOMode -> IO Handle)
-> IOMode -> [LispVal] -> IOThrowsError LispVal
makePort String -> IOMode -> IO Handle
openBinaryFile IOMode
WriteMode),
                (String
"open-output-string", [LispVal] -> IOThrowsError LispVal
openOutputString),
                (String
"open-input-string", [LispVal] -> IOThrowsError LispVal
openInputString),
                (String
"get-output-string", [LispVal] -> IOThrowsError LispVal
getOutputString),
                (String
"open-output-bytevector", [LispVal] -> IOThrowsError LispVal
openOutputByteVector),
                (String
"open-input-bytevector", [LispVal] -> IOThrowsError LispVal
openInputByteVector),
                (String
"get-output-bytevector", [LispVal] -> IOThrowsError LispVal
getOutputByteVector),
                (String
"close-port", [LispVal] -> IOThrowsError LispVal
closePort),
                (String
"close-input-port", [LispVal] -> IOThrowsError LispVal
closePort),
                (String
"close-output-port", [LispVal] -> IOThrowsError LispVal
closePort),
                (String
"flush-output-port", [LispVal] -> IOThrowsError LispVal
flushOutputPort),
                (String
"textual-port?", [LispVal] -> IOThrowsError LispVal
isTextPort),
                (String
"binary-port?", [LispVal] -> IOThrowsError LispVal
isBinaryPort),
                (String
"input-port-open?", [LispVal] -> IOThrowsError LispVal
isInputPortOpen),
                (String
"output-port-open?", [LispVal] -> IOThrowsError LispVal
isOutputPortOpen),
                (String
"input-port?", [LispVal] -> IOThrowsError LispVal
isInputPort),
                (String
"output-port?", [LispVal] -> IOThrowsError LispVal
isOutputPort),
                (String
"char-ready?", [LispVal] -> IOThrowsError LispVal
isCharReady),
                (String
"u8-ready?", [LispVal] -> IOThrowsError LispVal
isCharReady), -- Good enough?

               -- The following optional procedures are NOT implemented:
               --
               {- with-input-from-file
               with-output-from-file
               transcript-on
               transcript-off -}
               --
               {- Consideration may be given in a future release, but keep in mind
               the impact to the other I/O functions. -}

                (String
"current-input-port", [LispVal] -> IOThrowsError LispVal
currentInputPort),
                (String
"current-output-port", [LispVal] -> IOThrowsError LispVal
currentOutputPort),
                (String
"read", Bool -> [LispVal] -> IOThrowsError LispVal
readProc Bool
True),
                (String
"read-line", Bool -> [LispVal] -> IOThrowsError LispVal
readProc Bool
False),
                (String
"read-char", (Handle -> IO Char) -> [LispVal] -> IOThrowsError LispVal
readCharProc Handle -> IO Char
hGetChar),
                (String
"read-bytevector", [LispVal] -> IOThrowsError LispVal
readByteVector),
                (String
"read-string", [LispVal] -> IOThrowsError LispVal
readString),
                (String
"peek-char", (Handle -> IO Char) -> [LispVal] -> IOThrowsError LispVal
readCharProc Handle -> IO Char
hLookAhead),
                (String
"write", (Handle -> LispVal -> IO ()) -> [LispVal] -> IOThrowsError LispVal
forall a.
(Handle -> LispVal -> IO a) -> [LispVal] -> IOThrowsError LispVal
writeProc Handle -> LispVal -> IO ()
forall a. Show a => Handle -> a -> IO ()
hPrint),
                (String
"write-char", [LispVal] -> IOThrowsError LispVal
writeCharProc),
                (String
"write-bytevector", [LispVal] -> IOThrowsError LispVal
writeByteVector),
                (String
"write-string", [LispVal] -> IOThrowsError LispVal
writeString),
                (String
"display", (Handle -> LispVal -> IO ()) -> [LispVal] -> IOThrowsError LispVal
forall a.
(Handle -> LispVal -> IO a) -> [LispVal] -> IOThrowsError LispVal
writeProc (\ Handle
port LispVal
obj -> do
                  case LispVal
obj of
                    String String
str -> Handle -> String -> IO ()
hPutStr Handle
port String
str
                    LispVal
_ -> Handle -> String -> IO ()
hPutStr Handle
port (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ LispVal -> String
forall a. Show a => a -> String
show LispVal
obj)),

              (String
"string=?", (String -> String -> Bool) -> [LispVal] -> IOThrowsError LispVal
strBoolBinop String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==)),
              (String
"string<?", (String -> String -> Bool) -> [LispVal] -> IOThrowsError LispVal
strBoolBinop String -> String -> Bool
forall a. Ord a => a -> a -> Bool
(<)),
              (String
"string>?", (String -> String -> Bool) -> [LispVal] -> IOThrowsError LispVal
strBoolBinop String -> String -> Bool
forall a. Ord a => a -> a -> Bool
(>)),
              (String
"string<=?", (String -> String -> Bool) -> [LispVal] -> IOThrowsError LispVal
strBoolBinop String -> String -> Bool
forall a. Ord a => a -> a -> Bool
(<=)),
              (String
"string>=?", (String -> String -> Bool) -> [LispVal] -> IOThrowsError LispVal
strBoolBinop String -> String -> Bool
forall a. Ord a => a -> a -> Bool
(>=)),
              (String
"string-ci=?", [LispVal] -> IOThrowsError LispVal
stringCIEquals),
              (String
"string-ci<?", (String -> String -> Bool) -> [LispVal] -> IOThrowsError LispVal
stringCIBoolBinop String -> String -> Bool
forall a. Ord a => a -> a -> Bool
(<)),
              (String
"string-ci>?", (String -> String -> Bool) -> [LispVal] -> IOThrowsError LispVal
stringCIBoolBinop String -> String -> Bool
forall a. Ord a => a -> a -> Bool
(>)),
              (String
"string-ci<=?", (String -> String -> Bool) -> [LispVal] -> IOThrowsError LispVal
stringCIBoolBinop String -> String -> Bool
forall a. Ord a => a -> a -> Bool
(<=)),
              (String
"string-ci>=?", (String -> String -> Bool) -> [LispVal] -> IOThrowsError LispVal
stringCIBoolBinop String -> String -> Bool
forall a. Ord a => a -> a -> Bool
(>=)),
              (String
"string->symbol", [LispVal] -> IOThrowsError LispVal
string2Symbol),

              (String
"car", [LispVal] -> IOThrowsError LispVal
car),
              (String
"cdr", [LispVal] -> IOThrowsError LispVal
cdr),
              (String
"cons", [LispVal] -> IOThrowsError LispVal
cons),

              (String
"eq?",    [LispVal] -> IOThrowsError LispVal
eq),
              (String
"eqv?",   [LispVal] -> IOThrowsError LispVal
eq), -- TODO: not quite right, but maybe good enough for now
              (String
"equal?", ([LispVal] -> ThrowsError LispVal)
-> [LispVal] -> IOThrowsError LispVal
recDerefToFnc [LispVal] -> ThrowsError LispVal
equal),

              (String
"pair?", [LispVal] -> IOThrowsError LispVal
isDottedList),
              (String
"list?", (LispVal -> IOThrowsError LispVal)
-> [LispVal] -> IOThrowsError LispVal
unaryOp' LispVal -> IOThrowsError LispVal
isList),
              (String
"vector?", (LispVal -> IOThrowsError LispVal)
-> [LispVal] -> IOThrowsError LispVal
unaryOp' LispVal -> IOThrowsError LispVal
isVector),
              (String
"record?", (LispVal -> IOThrowsError LispVal)
-> [LispVal] -> IOThrowsError LispVal
unaryOp' LispVal -> IOThrowsError LispVal
isRecord),
              (String
"null?", [LispVal] -> IOThrowsError LispVal
isNull),
              (String
"string?", [LispVal] -> IOThrowsError LispVal
isString),

              (String
"list-copy", [LispVal] -> IOThrowsError LispVal
listCopy),

              (String
"string-length", [LispVal] -> IOThrowsError LispVal
stringLength),
              (String
"string-ref", [LispVal] -> IOThrowsError LispVal
stringRef),
              (String
"substring", [LispVal] -> IOThrowsError LispVal
substring),
              (String
"string-append", [LispVal] -> IOThrowsError LispVal
stringAppend),
              (String
"string->number", [LispVal] -> IOThrowsError LispVal
stringToNumber),
              (String
"string->list", [LispVal] -> IOThrowsError LispVal
stringToList),
              (String
"list->string", [LispVal] -> IOThrowsError LispVal
listToString),
              (String
"string->vector", [LispVal] -> IOThrowsError LispVal
stringToVector),
              (String
"vector->string", [LispVal] -> IOThrowsError LispVal
vectorToString),
              (String
"string-copy", [LispVal] -> IOThrowsError LispVal
stringCopy),
              (String
"string->utf8", [LispVal] -> IOThrowsError LispVal
byteVectorStr2Utf),

              (String
"bytevector?", (LispVal -> IOThrowsError LispVal)
-> [LispVal] -> IOThrowsError LispVal
unaryOp' LispVal -> IOThrowsError LispVal
isByteVector),
              (String
"bytevector-length", [LispVal] -> IOThrowsError LispVal
byteVectorLength),
              (String
"bytevector-u8-ref", [LispVal] -> IOThrowsError LispVal
byteVectorRef),
              (String
"bytevector-append", [LispVal] -> IOThrowsError LispVal
byteVectorAppend),
              (String
"bytevector-copy", [LispVal] -> IOThrowsError LispVal
byteVectorCopy),
              (String
"utf8->string", [LispVal] -> IOThrowsError LispVal
byteVectorUtf2Str),

              (String
"vector-length",([LispVal] -> ThrowsError LispVal)
-> [LispVal] -> IOThrowsError LispVal
wrapLeadObj [LispVal] -> ThrowsError LispVal
vectorLength),
              (String
"vector-ref",   ([LispVal] -> ThrowsError LispVal)
-> [LispVal] -> IOThrowsError LispVal
wrapLeadObj [LispVal] -> ThrowsError LispVal
vectorRef),
              (String
"vector-copy",  [LispVal] -> IOThrowsError LispVal
vectorCopy),
              (String
"vector->list", ([LispVal] -> ThrowsError LispVal)
-> [LispVal] -> IOThrowsError LispVal
wrapLeadObj [LispVal] -> ThrowsError LispVal
vectorToList),
              (String
"list->vector", ([LispVal] -> ThrowsError LispVal)
-> [LispVal] -> IOThrowsError LispVal
wrapLeadObj [LispVal] -> ThrowsError LispVal
listToVector),

              (String
"hash-table?",       ([LispVal] -> ThrowsError LispVal)
-> [LispVal] -> IOThrowsError LispVal
wrapHashTbl [LispVal] -> ThrowsError LispVal
isHashTbl),
              (String
"hash-table-exists?",([LispVal] -> ThrowsError LispVal)
-> [LispVal] -> IOThrowsError LispVal
wrapHashTbl [LispVal] -> ThrowsError LispVal
hashTblExists),
              (String
"hash-table-size",   ([LispVal] -> ThrowsError LispVal)
-> [LispVal] -> IOThrowsError LispVal
wrapHashTbl [LispVal] -> ThrowsError LispVal
hashTblSize),
              (String
"hash-table->alist", ([LispVal] -> ThrowsError LispVal)
-> [LispVal] -> IOThrowsError LispVal
wrapHashTbl [LispVal] -> ThrowsError LispVal
hashTbl2List),
              (String
"hash-table-keys",   ([LispVal] -> ThrowsError LispVal)
-> [LispVal] -> IOThrowsError LispVal
wrapHashTbl [LispVal] -> ThrowsError LispVal
hashTblKeys),
              (String
"hash-table-values", ([LispVal] -> ThrowsError LispVal)
-> [LispVal] -> IOThrowsError LispVal
wrapHashTbl [LispVal] -> ThrowsError LispVal
hashTblValues),
              (String
"hash-table-copy",   ([LispVal] -> ThrowsError LispVal)
-> [LispVal] -> IOThrowsError LispVal
wrapHashTbl [LispVal] -> ThrowsError LispVal
hashTblCopy),

                -- From SRFI 96
                (String
"file-exists?", [LispVal] -> IOThrowsError LispVal
fileExists),
                (String
"delete-file", [LispVal] -> IOThrowsError LispVal
deleteFile),

                -- husk internal functions
                --("husk-path", getDataFileFullPath'),

                -- Other I/O functions
                (String
"print-env", [LispVal] -> IOThrowsError LispVal
printEnv'),
                (String
"env-exports", [LispVal] -> IOThrowsError LispVal
exportsFromEnv'),
                (String
"read-contents", [LispVal] -> IOThrowsError LispVal
readContents),
                (String
"read-all", [LispVal] -> IOThrowsError LispVal
readAll),
                (String
"find-module-file", [LispVal] -> IOThrowsError LispVal
findModuleFile),
                (String
"system", [LispVal] -> IOThrowsError LispVal
system),
                (String
"get-environment-variables", [LispVal] -> IOThrowsError LispVal
getEnvVars),
--                ("system-read", systemRead),
                (String
"gensym", [LispVal] -> IOThrowsError LispVal
gensym)]


printEnv' :: [LispVal] -> IOThrowsError LispVal
printEnv' :: [LispVal] -> IOThrowsError LispVal
printEnv' [LispEnv Env
env] = do
    String
result <- IO String -> ExceptT LispError IO String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> ExceptT LispError IO String)
-> IO String -> ExceptT LispError IO String
forall a b. (a -> b) -> a -> b
$ Env -> IO String
printEnv Env
env
    LispVal -> IOThrowsError LispVal
forall (m :: * -> *) a. Monad m => a -> m a
return (LispVal -> IOThrowsError LispVal)
-> LispVal -> IOThrowsError LispVal
forall a b. (a -> b) -> a -> b
$ String -> LispVal
String String
result
printEnv' [] = LispError -> IOThrowsError LispVal
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (LispError -> IOThrowsError LispVal)
-> LispError -> IOThrowsError LispVal
forall a b. (a -> b) -> a -> b
$ Maybe Integer -> [LispVal] -> LispError
NumArgs (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
1) []
printEnv' [LispVal]
args = LispError -> IOThrowsError LispVal
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (LispError -> IOThrowsError LispVal)
-> LispError -> IOThrowsError LispVal
forall a b. (a -> b) -> a -> b
$ String -> LispVal -> LispError
TypeMismatch String
"env" (LispVal -> LispError) -> LispVal -> LispError
forall a b. (a -> b) -> a -> b
$ [LispVal] -> LispVal
List [LispVal]
args

exportsFromEnv' :: [LispVal] -> IOThrowsError LispVal
exportsFromEnv' :: [LispVal] -> IOThrowsError LispVal
exportsFromEnv' [LispEnv Env
env] = do
    [LispVal]
result <- IO [LispVal] -> ExceptT LispError IO [LispVal]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [LispVal] -> ExceptT LispError IO [LispVal])
-> IO [LispVal] -> ExceptT LispError IO [LispVal]
forall a b. (a -> b) -> a -> b
$ Env -> IO [LispVal]
exportsFromEnv Env
env
    LispVal -> IOThrowsError LispVal
forall (m :: * -> *) a. Monad m => a -> m a
return (LispVal -> IOThrowsError LispVal)
-> LispVal -> IOThrowsError LispVal
forall a b. (a -> b) -> a -> b
$ [LispVal] -> LispVal
List [LispVal]
result
exportsFromEnv' [LispVal]
_ = LispVal -> IOThrowsError LispVal
forall (m :: * -> *) a. Monad m => a -> m a
return (LispVal -> IOThrowsError LispVal)
-> LispVal -> IOThrowsError LispVal
forall a b. (a -> b) -> a -> b
$ [LispVal] -> LispVal
List []

-- | Pure primitive functions
primitives :: [(String, [LispVal] -> ThrowsError LispVal)]
primitives :: [(String, [LispVal] -> ThrowsError LispVal)]
primitives = [(String
"+", [LispVal] -> ThrowsError LispVal
numAdd),
              (String
"-", [LispVal] -> ThrowsError LispVal
numSub),
              (String
"*", [LispVal] -> ThrowsError LispVal
numMul),
              (String
"/", [LispVal] -> ThrowsError LispVal
numDiv),
              (String
"modulo", [LispVal] -> ThrowsError LispVal
numMod),
              (String
"quotient", (Integer -> Integer -> Integer) -> [LispVal] -> ThrowsError LispVal
numericBinop Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot),
              (String
"remainder", (Integer -> Integer -> Integer) -> [LispVal] -> ThrowsError LispVal
numericBinop Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem),
              (String
"rationalize", [LispVal] -> ThrowsError LispVal
numRationalize),

              (String
"round", [LispVal] -> ThrowsError LispVal
numRound),
              (String
"floor", [LispVal] -> ThrowsError LispVal
numFloor),
              (String
"ceiling", [LispVal] -> ThrowsError LispVal
numCeiling),
              (String
"truncate", [LispVal] -> ThrowsError LispVal
numTruncate),

              (String
"numerator", [LispVal] -> ThrowsError LispVal
numNumerator),
              (String
"denominator", [LispVal] -> ThrowsError LispVal
numDenominator),

              (String
"exp", [LispVal] -> ThrowsError LispVal
numExp),
              (String
"log", [LispVal] -> ThrowsError LispVal
numLog),
              (String
"sin", [LispVal] -> ThrowsError LispVal
numSin),
              (String
"cos", [LispVal] -> ThrowsError LispVal
numCos),
              (String
"tan", [LispVal] -> ThrowsError LispVal
numTan),
              (String
"asin", [LispVal] -> ThrowsError LispVal
numAsin),
              (String
"acos", [LispVal] -> ThrowsError LispVal
numAcos),
              (String
"atan", [LispVal] -> ThrowsError LispVal
numAtan),

              (String
"sqrt", [LispVal] -> ThrowsError LispVal
numSqrt),
              (String
"expt", [LispVal] -> ThrowsError LispVal
numExpt),

              (String
"make-rectangular", [LispVal] -> ThrowsError LispVal
numMakeRectangular),
              (String
"make-polar", [LispVal] -> ThrowsError LispVal
numMakePolar),
              (String
"real-part", [LispVal] -> ThrowsError LispVal
numRealPart ),
              (String
"imag-part", [LispVal] -> ThrowsError LispVal
numImagPart),
              (String
"magnitude", [LispVal] -> ThrowsError LispVal
numMagnitude),
              (String
"angle", [LispVal] -> ThrowsError LispVal
numAngle ),

              (String
"exact->inexact", [LispVal] -> ThrowsError LispVal
numExact2Inexact),
              (String
"inexact->exact", [LispVal] -> ThrowsError LispVal
numInexact2Exact),

              (String
"number->string", [LispVal] -> ThrowsError LispVal
num2String),

              (String
"=", [LispVal] -> ThrowsError LispVal
numBoolBinopEq),
              (String
">", [LispVal] -> ThrowsError LispVal
numBoolBinopGt),
              (String
">=", [LispVal] -> ThrowsError LispVal
numBoolBinopGte),
              (String
"<", [LispVal] -> ThrowsError LispVal
numBoolBinopLt),
              (String
"<=", [LispVal] -> ThrowsError LispVal
numBoolBinopLte),

              (String
"&&", (Bool -> Bool -> Bool) -> [LispVal] -> ThrowsError LispVal
boolBoolBinop Bool -> Bool -> Bool
(&&)),
              (String
"||", (Bool -> Bool -> Bool) -> [LispVal] -> ThrowsError LispVal
boolBoolBinop Bool -> Bool -> Bool
(||)),

              (String
"char=?",  (Char -> Char -> Bool) -> [LispVal] -> ThrowsError LispVal
charBoolBinop Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==)),
              (String
"char<?",  (Char -> Char -> Bool) -> [LispVal] -> ThrowsError LispVal
charBoolBinop Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
(<)),
              (String
"char>?",  (Char -> Char -> Bool) -> [LispVal] -> ThrowsError LispVal
charBoolBinop Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
(>)),
              (String
"char<=?", (Char -> Char -> Bool) -> [LispVal] -> ThrowsError LispVal
charBoolBinop Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
(<=)),
              (String
"char>=?", (Char -> Char -> Bool) -> [LispVal] -> ThrowsError LispVal
charBoolBinop Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
(>=)),
              (String
"char-ci=?",  (Char -> Char -> Bool) -> [LispVal] -> ThrowsError LispVal
charCIBoolBinop Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==)),
              (String
"char-ci<?",  (Char -> Char -> Bool) -> [LispVal] -> ThrowsError LispVal
charCIBoolBinop Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
(<)),
              (String
"char-ci>?",  (Char -> Char -> Bool) -> [LispVal] -> ThrowsError LispVal
charCIBoolBinop Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
(>)),
              (String
"char-ci<=?", (Char -> Char -> Bool) -> [LispVal] -> ThrowsError LispVal
charCIBoolBinop Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
(<=)),
              (String
"char-ci>=?", (Char -> Char -> Bool) -> [LispVal] -> ThrowsError LispVal
charCIBoolBinop Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
(>=)),
              (String
"char-alphabetic?", (Char -> Bool) -> [LispVal] -> ThrowsError LispVal
charPredicate Char -> Bool
Data.Char.isAlpha),
              (String
"char-numeric?", (Char -> Bool) -> [LispVal] -> ThrowsError LispVal
charPredicate Char -> Bool
Data.Char.isNumber),
              (String
"char-whitespace?", (Char -> Bool) -> [LispVal] -> ThrowsError LispVal
charPredicate Char -> Bool
Data.Char.isSpace),
              (String
"char-upper-case?", (Char -> Bool) -> [LispVal] -> ThrowsError LispVal
charPredicate Char -> Bool
Data.Char.isUpper),
              (String
"char-lower-case?", (Char -> Bool) -> [LispVal] -> ThrowsError LispVal
charPredicate Char -> Bool
Data.Char.isLower),
              (String
"char->integer", [LispVal] -> ThrowsError LispVal
char2Int),
              (String
"integer->char", [LispVal] -> ThrowsError LispVal
int2Char),
              (String
"char-upcase", [LispVal] -> ThrowsError LispVal
charUpper),
              (String
"char-downcase", [LispVal] -> ThrowsError LispVal
charLower),
              (String
"digit-value", [LispVal] -> ThrowsError LispVal
charDigitValue),

              (String
"procedure?", [LispVal] -> ThrowsError LispVal
isProcedure),
              (String
"nan?", [LispVal] -> ThrowsError LispVal
isNumNaN),
              (String
"infinite?", [LispVal] -> ThrowsError LispVal
isNumInfinite),
              (String
"finite?", [LispVal] -> ThrowsError LispVal
isNumFinite),
              (String
"exact?", [LispVal] -> ThrowsError LispVal
isNumExact),
              (String
"inexact?", [LispVal] -> ThrowsError LispVal
isNumInexact),
              (String
"number?", [LispVal] -> ThrowsError LispVal
isNumber),
              (String
"complex?", [LispVal] -> ThrowsError LispVal
isComplex),
              (String
"real?", [LispVal] -> ThrowsError LispVal
isReal),
              (String
"rational?", [LispVal] -> ThrowsError LispVal
isRational),
              (String
"integer?", [LispVal] -> ThrowsError LispVal
isInteger),
              (String
"eof-object?", [LispVal] -> ThrowsError LispVal
isEOFObject),
              (String
"eof-object", [LispVal] -> ThrowsError LispVal
eofObject),
              (String
"symbol?", [LispVal] -> ThrowsError LispVal
isSymbol),
              (String
"symbol=?", [LispVal] -> ThrowsError LispVal
forall (m :: * -> *). Monad m => [LispVal] -> m LispVal
isSymbolEq),
              (String
"symbol->string", [LispVal] -> ThrowsError LispVal
symbol2String),
              (String
"char?", [LispVal] -> ThrowsError LispVal
isChar),

              (String
"make-list", [LispVal] -> ThrowsError LispVal
makeList),
              (String
"make-vector", [LispVal] -> ThrowsError LispVal
makeVector),
              (String
"vector", [LispVal] -> ThrowsError LispVal
buildVector),

              (String
"make-bytevector", [LispVal] -> ThrowsError LispVal
makeByteVector),
              (String
"bytevector", [LispVal] -> ThrowsError LispVal
byteVector),

              (String
"make-hash-table", [LispVal] -> ThrowsError LispVal
hashTblMake),
              (String
"string", [LispVal] -> ThrowsError LispVal
buildString),
              (String
"make-string", [LispVal] -> ThrowsError LispVal
makeString),

              (String
"boolean?", [LispVal] -> ThrowsError LispVal
isBoolean),
              (String
"boolean=?", [LispVal] -> ThrowsError LispVal
forall (m :: * -> *). Monad m => [LispVal] -> m LispVal
isBooleanEq),

              (String
"husk-interpreter?", [LispVal] -> ThrowsError LispVal
isInterpreter)]

-- |Custom function used internally in the test suite
isInterpreter :: [LispVal] -> ThrowsError LispVal
isInterpreter :: [LispVal] -> ThrowsError LispVal
isInterpreter [] = LispVal -> ThrowsError LispVal
forall (m :: * -> *) a. Monad m => a -> m a
return (LispVal -> ThrowsError LispVal) -> LispVal -> ThrowsError LispVal
forall a b. (a -> b) -> a -> b
$ Bool -> LispVal
Bool Bool
True
isInterpreter [LispVal]
_ = LispVal -> ThrowsError LispVal
forall (m :: * -> *) a. Monad m => a -> m a
return (LispVal -> ThrowsError LispVal) -> LispVal -> ThrowsError LispVal
forall a b. (a -> b) -> a -> b
$ Bool -> LispVal
Bool Bool
False