summaryrefslogtreecommitdiff
path: root/Com/Simatime/Language/Bs/Expr.hs
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2020-04-15 09:54:10 -0700
committerBen Sima <ben@bsima.me>2020-04-15 10:06:56 -0700
commitf4b8c0df041b063c0b47d2ec6c818a9c202fd833 (patch)
tree01ad246a83fda29c079847b3397ca6509a7f6106 /Com/Simatime/Language/Bs/Expr.hs
parent6ed475ca94209ce92e75f48764cb9d361029ea26 (diff)
Re-namespacing
Moving away from the DNS-driven namespacing toward more condensed names, mostly because I don't like typing so much.
Diffstat (limited to 'Com/Simatime/Language/Bs/Expr.hs')
-rw-r--r--Com/Simatime/Language/Bs/Expr.hs154
1 files changed, 0 insertions, 154 deletions
diff --git a/Com/Simatime/Language/Bs/Expr.hs b/Com/Simatime/Language/Bs/Expr.hs
deleted file mode 100644
index a39c7b6..0000000
--- a/Com/Simatime/Language/Bs/Expr.hs
+++ /dev/null
@@ -1,154 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-module Language.Bs.Expr where
-
-import Data.String (String)
-import Data.Text (Text)
-import qualified Data.Text as T
-import GHC.Show
-import Protolude hiding (show)
-import qualified Text.PrettyPrint.Leijen.Text as PP
-import Text.PrettyPrint.Leijen.Text hiding ((<$>))
-
-type Ctx = Map Text Expr
-data Env = Env { env :: Ctx, fenv :: Ctx }
- deriving (Eq)
-
-newtype Eval a = Eval { unEval :: ReaderT Env IO a }
- deriving (Monad, Functor, Applicative, MonadReader Env, MonadIO)
-
-data IFunc = IFunc { fn :: [Expr] -> Eval Expr }
- deriving (Typeable)
-
-instance Eq IFunc where
- (==) _ _ = False
-
-data Expr
- = Atom Text
- | List [Expr]
- | Numb Integer
- | Tape Text
- | IFun IFunc -- TODO: call this Kern
- | Func IFunc Env
- | Bool Bool
- | Nil
- deriving (Typeable, Eq)
-
-instance Show Expr where
- show = T.unpack . ppexpr
-
-data LispErrorType
- = NumArgs Integer [Expr]
- | LengthOfList Text Int
- | ExpectedList Text
- | ParseError String
- | TypeMismatch Text Expr
- | BadSpecialForm Text
- | NotFunction Expr
- | UnboundVar Text
- | Default Expr
- | ReadFileError Text
- deriving (Typeable)
-
-data LispError = LispError Expr LispErrorType
-
-instance Show LispErrorType where
- show = T.unpack . ppexpr
-
-instance Show LispError where
- show = T.unpack . ppexpr
-
-instance Exception LispErrorType
-instance Exception LispError
-
-ppexpr :: Pretty a => a -> Text
-ppexpr x = PP.displayTStrict (PP.renderPretty 1.0 70 (pretty x))
-
---prettyList :: [Doc] -> Doc
---prettyList = encloseSep lparen rparen PP.space
-
-instance Pretty Expr where
- pretty v =
- case v of
- Atom a ->
- textStrict a
-
- List ls ->
- prettyList $ fmap pretty ls
-
- Numb n ->
- integer n
-
- Tape t ->
- textStrict "\"" <> textStrict t <> textStrict "\""
-
- IFun _ ->
- textStrict "<internal function>"
-
- Func _ _ ->
- textStrict "<lambda function>"
-
- Bool True ->
- textStrict "#t"
-
- Bool False ->
- textStrict "#f"
-
- Nil ->
- textStrict "'()"
-
-instance Pretty LispErrorType where
- pretty err = case err of
- NumArgs i args ->
- textStrict "number of arguments"
- <$$> textStrict "expected"
- <+> textStrict (T.pack $ show i)
- <$$> textStrict "received"
- <+> textStrict (T.pack $ show $ length args)
-
-
- LengthOfList txt i ->
- textStrict "length of list in:"
- <+> textStrict txt
- <$$> textStrict "length:"
- <+> textStrict (T.pack $ show i)
-
- ParseError txt ->
- textStrict "cannot parse expr:"
- <+> textStrict (T.pack txt)
-
- TypeMismatch txt expr ->
- textStrict "type mismatch:"
- <$$> textStrict txt
- <$$> pretty expr
-
- BadSpecialForm txt ->
- textStrict "bad special form:"
- <$$> textStrict txt
-
- NotFunction expr ->
- textStrict "not a function"
- <$$> pretty expr
-
- UnboundVar txt ->
- textStrict "unbound variable:"
- <$$> textStrict txt
-
- Default _ ->
- textStrict "default error"
-
- ReadFileError txt ->
- textStrict "error reading file:"
- <$$> textStrict txt
-
- ExpectedList txt ->
- textStrict "expected list:"
- <$$> textStrict txt
-
-instance Pretty LispError where
- pretty (LispError expr typ) =
- textStrict "error evaluating:"
- <$$> indent 4 (pretty expr)
- <$$> pretty typ