From dd581b11fd4f682a61df77d5d9206be04457263f Mon Sep 17 00:00:00 2001 From: Ivy Date: Thu, 28 Jan 2021 02:16:30 +0100 Subject: [PATCH] First commit --- LICENSE | 30 ++++++++++++++++++ README.md | 13 ++++++++ Setup.hs | 2 ++ cherry-lisp.cabal | 31 +++++++++++++++++++ src/Evaluator.hs | 26 ++++++++++++++++ src/ExprParser.hs | 77 ++++++++++++++++++++++++++++++++++++++++++++++ src/ExprType.hs | 12 ++++++++ src/Main.hs | 35 +++++++++++++++++++++ src/ParserUtils.hs | 15 +++++++++ src/TokenParser.hs | 38 +++++++++++++++++++++++ src/TokenType.hs | 9 ++++++ stack.yaml | 66 +++++++++++++++++++++++++++++++++++++++ 12 files changed, 354 insertions(+) create mode 100644 LICENSE create mode 100644 README.md create mode 100644 Setup.hs create mode 100644 cherry-lisp.cabal create mode 100644 src/Evaluator.hs create mode 100644 src/ExprParser.hs create mode 100644 src/ExprType.hs create mode 100644 src/Main.hs create mode 100644 src/ParserUtils.hs create mode 100644 src/TokenParser.hs create mode 100644 src/TokenType.hs create mode 100644 stack.yaml diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..bc59db9 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2021 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/README.md b/README.md new file mode 100644 index 0000000..e0de134 --- /dev/null +++ b/README.md @@ -0,0 +1,13 @@ +# Cherry Lisp +A tiny and lazy lisp. + +``` + /\ + | \ + @ @ + +cherry> (+ 2 3 4) +9 +``` + +Work in progress... diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cherry-lisp.cabal b/cherry-lisp.cabal new file mode 100644 index 0000000..86c6a97 --- /dev/null +++ b/cherry-lisp.cabal @@ -0,0 +1,31 @@ +name: cherry-lisp +version: 0.1.0.0 +-- synopsis: +-- description: +--homepage: https://github.com/githubuser/lisp#readme +license: BSD3 +license-file: LICENSE +author: Suguivy +maintainer: suguivy@riseup.com +copyright: 2021 Suguivy +category: Language +build-type: Simple +cabal-version: >=1.10 +extra-source-files: README.md + +executable cherry + hs-source-dirs: src + main-is: Main.hs + default-language: Haskell2010 + + other-modules: ExprType, + ExprParser, + TokenType, + TokenParser, + Evaluator, + ParserUtils, + TokenParser + + build-depends: base >= 4.7 && < 5, + containers, + parsec diff --git a/src/Evaluator.hs b/src/Evaluator.hs new file mode 100644 index 0000000..4d2d982 --- /dev/null +++ b/src/Evaluator.hs @@ -0,0 +1,26 @@ +module Evaluator where + +import qualified Data.Map as M +import ExprType + +type Env = M.Map String Expr +type Proc = String +type Args = [Expr] + +eval :: Expr -> Expr +eval (IntE x) = IntE x +eval (VarE v) = VarE v +eval (DefinitionE v exp) = NilE +eval (ProcedureE p args) = apply p args +eval NilE = NilE + +apply :: Proc -> Args -> Expr +apply p args + | p == "+" = builtinPlus $ map eval args + +-- TODO: create a BuiltinProc or something like that in data Expr, and make + a builtin proc + +builtinPlus :: [Expr] -> Expr +builtinPlus [IntE x, IntE y] = IntE $ x + y +builtinPlus ((IntE x):xs) = IntE $ x + n + where (IntE n) = builtinPlus xs diff --git a/src/ExprParser.hs b/src/ExprParser.hs new file mode 100644 index 0000000..49e40c6 --- /dev/null +++ b/src/ExprParser.hs @@ -0,0 +1,77 @@ +module ExprParser where + +import Text.Parsec +import Text.Parsec.String +import TokenParser +import TokenType +import ExprType + +parseExpression :: String -> Either ParseError Expr +parseExpression s = do + tokns <- parse parseTokens "lexical error" s + expr <- parse parseExpressionFromTokens "parsing error" tokns + return expr + +parseExpressionFromTokens :: GenParser Token st Expr +parseExpressionFromTokens = intE <|> try defineE <|> try nilE <|> varE <|> procedureE + +intE :: GenParser Token st Expr +intE = do + (IntT num) <- parseIntT + return $ IntE num + +procedureE :: GenParser Token st Expr +procedureE = do + _ <- parseLeftParenT + (VarT p) <- parseVarT + args <- many parseExpressionFromTokens + _ <- parseRightParenT + return $ ProcedureE p args + +varE :: GenParser Token st Expr +varE = do + (VarT var) <- parseVarT + return $ VarE var + +nilE :: GenParser Token st Expr +nilE = do + _ <- parseNilT + return NilE + +defineE :: GenParser Token st Expr +defineE = do + _ <- parseLeftParenT + _ <- parseDefineT + (VarT var) <- parseVarT + expr <- parseExpressionFromTokens + _ <- parseRightParenT + return $ DefinitionE var expr + +------------------------------------------------------------ + +satisfyT :: (Stream s m a, Show a) => (a -> Bool) -> ParsecT s u m a +satisfyT f = tokenPrim show + (\pos _ _ -> incSourceColumn pos 1) + (\t -> if f t then Just t else Nothing) + +parseLeftParenT :: GenParser Token st Token +parseLeftParenT = satisfyT (== LeftParenT) + +parseRightParenT :: GenParser Token st Token +parseRightParenT = satisfyT (== RightParenT) + +parseDefineT :: GenParser Token st Token +parseDefineT = satisfyT (== DefineT) + +parseNilT :: GenParser Token st Token +parseNilT = satisfyT (== NilT) + +parseVarT :: GenParser Token st Token +parseVarT = satisfyT isVarT + where isVarT (VarT _) = True + isVarT _ = False + +parseIntT :: GenParser Token st Token +parseIntT = satisfyT isIntT + where isIntT (IntT _) = True + isIntT _ = False diff --git a/src/ExprType.hs b/src/ExprType.hs new file mode 100644 index 0000000..558ac67 --- /dev/null +++ b/src/ExprType.hs @@ -0,0 +1,12 @@ +module ExprType where + +data Expr = IntE Integer + | VarE String + | ProcedureE String [Expr] + | DefinitionE String Expr + | NilE + +instance Show Expr where + show (IntE x) = show x + show (VarE x) = x ++ " ; var" + show NilE = "nil" diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 index 0000000..3b82d59 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,35 @@ +module Main where + +import Evaluator +import ExprParser +import Text.Parsec.Error +import Data.Either +import System.IO + +main :: IO () +main = do + putStrLn "" + putLogo + putStrLn "" + cycle + where cycle = do + putPrompt + hFlush stdout + s <- getLine + let r = readEval s + putStrLn $ case r of + (Right res) -> res + (Left err) -> show err + cycle + +readEval :: String -> Either ParseError String +readEval s = do + expr <- parseExpression s + let result = eval expr + return $ show result + +putLogo :: IO () +putLogo = putStr . concat $ map (++"\n") [" /\\", " | \\", " @ @"] + +putPrompt :: IO () +putPrompt = putStr "chery> " diff --git a/src/ParserUtils.hs b/src/ParserUtils.hs new file mode 100644 index 0000000..0eaee62 --- /dev/null +++ b/src/ParserUtils.hs @@ -0,0 +1,15 @@ +module ParserUtils where + +import Text.ParserCombinators.Parsec +import Data.Char + +caseInsensitiveString :: String -> GenParser Char st String +caseInsensitiveString "" = return "" +caseInsensitiveString [x] = (: []) <$> caseInsensitiveChar x +caseInsensitiveString (x:xs) = do + c <- caseInsensitiveChar x + s <- caseInsensitiveString xs + return (c:s) + +caseInsensitiveChar :: Char -> GenParser Char st Char +caseInsensitiveChar c = char (toLower c) <|> char (toUpper c) diff --git a/src/TokenParser.hs b/src/TokenParser.hs new file mode 100644 index 0000000..3e1afd7 --- /dev/null +++ b/src/TokenParser.hs @@ -0,0 +1,38 @@ +module TokenParser where + +import Text.ParserCombinators.Parsec +import ParserUtils +import Data.Char +import TokenType + +parseTokens :: GenParser Char st [Token] +parseTokens = do + _ <- spaces + many $ (spaces >> anyLispToken) + +anyLispToken :: GenParser Char st Token +anyLispToken = leftParenT <|> rightParenT <|> try nilT <|> try defineT <|> varT <|> intT + +------------------------------------------------------------ + +intT :: GenParser Char st Token +intT = do + number <- read <$> many1 digit + return $ IntT number + +leftParenT :: GenParser Char st Token +leftParenT = char '(' >> return LeftParenT + +rightParenT :: GenParser Char st Token +rightParenT = char ')' >> return RightParenT + +defineT :: GenParser Char st Token +defineT = caseInsensitiveString "define" >> return DefineT + +nilT :: GenParser Char st Token +nilT = caseInsensitiveString "nil" >> return NilT + +varT :: GenParser Char st Token +varT = do + var <- map toLower <$> many1 (letter <|> oneOf "+-*/!|@#$~%&/=<>") + return $ VarT var diff --git a/src/TokenType.hs b/src/TokenType.hs new file mode 100644 index 0000000..b357518 --- /dev/null +++ b/src/TokenType.hs @@ -0,0 +1,9 @@ +module TokenType where + +data Token = LeftParenT + | RightParenT + | DefineT + | VarT String + | IntT Integer + | NilT + deriving (Show, Eq) diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..07d7023 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,66 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# +# The location of a snapshot can be provided as a file or url. Stack assumes +# a snapshot provided as a file might change, whereas a url resource does not. +# +# resolver: ./custom-snapshot.yaml +# resolver: https://example.com/snapshots/2018-01-01.yaml +resolver: lts-17.0 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# subdirs: +# - auto-update +# - wai +packages: +- . +# Dependency packages to be pulled from upstream that are not in the resolver. +# These entries can reference officially published versions as well as +# forks / in-progress versions pinned to a git hash. For example: +# +# extra-deps: +# - acme-missiles-0.3 +# - git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# +# extra-deps: [] + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=2.3" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor