├── .gitignore ├── Setup.hs ├── test ├── Spec.hs └── CoreSpec.hs ├── app └── Main.hs ├── README.md ├── src ├── Eval.hs ├── Reader.hs └── Core.hs ├── stack.yaml ├── LICENSE └── toylisp.cabal /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 2 | -------------------------------------------------------------------------------- /app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | main :: IO () 4 | main = do 5 | putStrLn "hello world" 6 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Toylisp 2 | 3 | A toy lisp interpreter written in Haskell. 4 | 5 | Still a work in progress. 6 | -------------------------------------------------------------------------------- /src/Eval.hs: -------------------------------------------------------------------------------- 1 | module Eval where 2 | 3 | import Core 4 | 5 | eval :: Env -> Form -> (Env, Value) 6 | eval env (Atom (Symbol sym)) = (env, lookupEnv env sym) 7 | eval env (Atom val) = (env, AtomValue val) 8 | -------------------------------------------------------------------------------- /src/Reader.hs: -------------------------------------------------------------------------------- 1 | module Reader where 2 | 3 | import Core 4 | import Text.Parsec 5 | import Text.Parsec.Char 6 | 7 | type Parser = Parsec String Bool 8 | 9 | lispInt :: Parser Atom 10 | lispInt = do 11 | digits <- many1 digit 12 | return $ Int (read digits :: Int) 13 | 14 | lispBoolean :: Parser Atom 15 | lispBoolean = 16 | (string "true" >> (return $ Bool True)) <|> 17 | (string "false" >> (return $ Bool False)) 18 | 19 | symbolSpecialChars = char '*' <|> char '_' <|> char '-' <|> char '$' 20 | 21 | lispSymbol :: Parser Atom 22 | lispSymbol = do 23 | x <- letter <|> symbolSpecialChars 24 | xs <- many $ alphaNum <|> symbolSpecialChars 25 | return $ Symbol $ Sym (x : xs) 26 | 27 | lispAtom :: Parser Form 28 | lispAtom = fmap Atom (lispBoolean <|> lispInt <|> lispSymbol) 29 | 30 | quote form = (Atom $ Symbol $ Sym "quote") : form 31 | 32 | inParens = between (char '(') (char ')') 33 | 34 | lispSexp :: Parser Form 35 | lispSexp = do 36 | quo <- option False (char '\'' >> return True) 37 | forms <- inParens $ lisp `sepBy` spaces 38 | return $ 39 | SExp $ 40 | if quo 41 | then (quote forms) 42 | else forms 43 | 44 | lisp = lispAtom <|> lispSexp 45 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration.html 2 | 3 | # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) 4 | resolver: lts-5.2 5 | 6 | # Local packages, usually specified by relative directory name 7 | packages: 8 | - '.' 9 | 10 | # Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3) 11 | extra-deps: [] 12 | 13 | # Override default flag values for local packages and extra-deps 14 | flags: {} 15 | 16 | # Extra package databases containing global packages 17 | extra-package-dbs: [] 18 | 19 | # Control whether we use the GHC we find on the path 20 | # system-ghc: true 21 | 22 | # Require a specific version of stack, using version ranges 23 | # require-stack-version: -any # Default 24 | # require-stack-version: >= 1.0.0 25 | 26 | # Override the architecture used by stack, especially useful on Windows 27 | # arch: i386 28 | # arch: x86_64 29 | 30 | # Extra directories used by stack for building 31 | # extra-include-dirs: [/path/to/dir] 32 | # extra-lib-dirs: [/path/to/dir] 33 | 34 | # Allow a newer minor version of GHC than the snapshot specifies 35 | # compiler-check: newer-minor 36 | -------------------------------------------------------------------------------- /test/CoreSpec.hs: -------------------------------------------------------------------------------- 1 | module CoreSpec (spec) where 2 | 3 | import Core 4 | import Test.Hspec 5 | 6 | spec :: Spec 7 | spec = do 8 | 9 | describe "Environment" $ do 10 | 11 | it "sets parent to Nothing for empty env" $ do 12 | parent emptyEnv `shouldBe` Nothing 13 | 14 | let currentEnv = emptyEnv 15 | let newEnv = pushEnv currentEnv [(Sym "foo", AtomValue $ String "123")] 16 | 17 | it "sets parent to current env when pushing new env" $ do 18 | parent newEnv `shouldBe` Just currentEnv 19 | 20 | it "gets back parent env when poping old env" $ do 21 | popEnv newEnv `shouldBe` currentEnv 22 | 23 | describe "Lookup Stuff in Environment" $ do 24 | 25 | let testVal1 = AtomValue $ String "123" 26 | let testVal2 = AtomValue $ Int 12 27 | let testVal3 = AtomValue Nil 28 | let testEnv = pushEnv emptyEnv [(Sym "foo", testVal1), 29 | (Sym "bar", testVal2), 30 | (Sym "foobar", testVal3)] 31 | 32 | it "returns correct value from current env" $ do 33 | lookupEnv testEnv (Sym "foo") `shouldBe` testVal1 34 | lookupEnv testEnv (Sym "bar") `shouldBe` testVal2 35 | lookupEnv testEnv (Sym "foobar") `shouldBe` testVal3 36 | 37 | let newEnv = pushEnv testEnv [] 38 | 39 | it "returns correct value from parent env" $ do 40 | lookupEnv newEnv (Sym "foo") `shouldBe` testVal1 41 | lookupEnv newEnv (Sym "bar") `shouldBe` testVal2 42 | lookupEnv newEnv (Sym "foobar") `shouldBe` testVal3 43 | -------------------------------------------------------------------------------- /src/Core.hs: -------------------------------------------------------------------------------- 1 | module Core where 2 | 3 | import qualified Data.Map as M 4 | 5 | data Sym = 6 | Sym String 7 | deriving (Show,Eq,Ord) 8 | 9 | data Atom 10 | = Nil 11 | | Bool Bool 12 | | String String 13 | | Int Int 14 | | Symbol Sym 15 | deriving (Show,Eq,Ord) 16 | 17 | data Form 18 | = SExp [Form] 19 | | Atom Atom 20 | deriving (Show,Eq,Ord) 21 | 22 | data Lambda = Lambda 23 | { args :: [Sym] 24 | , body :: Form 25 | , env :: Env 26 | } deriving (Show,Eq,Ord) 27 | 28 | data Value 29 | = AtomValue Atom 30 | | ListValue [Value] 31 | | LambdaValue Lambda 32 | deriving (Show,Eq,Ord) 33 | 34 | data Env = Env 35 | { bindings :: M.Map Sym Value 36 | , parent :: Maybe Env 37 | } deriving (Show,Eq,Ord) 38 | 39 | 40 | emptyEnv :: Env 41 | emptyEnv = 42 | Env 43 | { bindings = M.empty 44 | , parent = Nothing 45 | } 46 | 47 | pushEnv :: Env -> [(Sym, Value)] -> Env 48 | pushEnv env bindings = 49 | Env 50 | { bindings = M.fromList bindings 51 | , parent = Just env 52 | } 53 | 54 | popEnv :: Env -> Env 55 | popEnv env = case parent env of 56 | Just env -> env 57 | Nothing -> error "Trying to pop the root env" -- TODO A better way to handle this case ? 58 | 59 | -- Lookup a binding in a Env 60 | lookupEnv :: Env -> Sym -> Value 61 | lookupEnv env sym = 62 | case M.lookup sym (bindings env) of 63 | Just val -> val 64 | Nothing -> 65 | case (parent env) of 66 | Just p -> lookupEnv p sym 67 | Nothing -> AtomValue Nil 68 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Jerry Peng(c) 2016 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /toylisp.cabal: -------------------------------------------------------------------------------- 1 | name: toylisp 2 | version: 0.1.0.0 3 | synopsis: A toy lisp interpreter 4 | description: Please see README.md 5 | homepage: http://github.com/moonranger/toylisp 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Jerry Peng 9 | maintainer: pr2jerry@gmail.com 10 | copyright: 2016 Jerry Peng 11 | category: Intepreter 12 | build-type: Simple 13 | -- extra-source-files: 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | exposed-modules: Core 19 | , Eval 20 | , Reader 21 | build-depends: base >= 4.7 && < 5 22 | , containers >= 0.5.6 23 | , parsec >= 3.1.9 24 | default-language: Haskell2010 25 | 26 | executable toylisp-exe 27 | hs-source-dirs: app 28 | main-is: Main.hs 29 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 30 | build-depends: base 31 | , toylisp 32 | default-language: Haskell2010 33 | 34 | test-suite toylisp-test 35 | type: exitcode-stdio-1.0 36 | hs-source-dirs: test 37 | main-is: Spec.hs 38 | build-depends: base 39 | , toylisp 40 | , hspec >= 2.2.2 41 | , QuickCheck >= 2.8 42 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 43 | default-language: Haskell2010 44 | 45 | source-repository head 46 | type: git 47 | location: https://github.com/moonranger/toylisp 48 | --------------------------------------------------------------------------------