lisp.hs

module Main where

import Text.ParserCombinators.Parsec
import Control.Monad.Error
import System.Environment

main = getArgs >>= putStrLn . readExpr . head

-- Parser

readExpr :: String -> String
readExpr x =
  case parse parseExpr "lisp" x of
    Left err -> "MUHAHAH" ++ show err
    Right val -> "KEBAB!"

parseNumber :: Parser Value
parseNumber = do
  sign <- many (oneOf "-")
  num <- many1 digit
  case sign of
    "-" -> return $ Number . negate $ read num
    _ -> return $ Number $ read num

parseBool :: Parser Value
parseBool = do
  bool <- many1 letter
  case bool of
    "True" -> return $ Bool True
    "False" -> return $ Bool False

parseString :: Parser Value
parseString = do
  char '"'
  str <- many (noneOf "\"")
  char '"'
  return $ String str

parseList :: Parser Value
parseList = do
  char '['
  xs <- sepBy parseValues (char ' ')
  char '['
  return $ List xs

parseValues :: Parser Value
parseValues =
  parseNumber <|>
  parseBool <|>
  parseString <|>
  parseList

valueToExpr :: Value -> Expr
valueToExpr = return . Value

parseCode ::  Parser Expr
parseCode = fmap Code $ sepBy parseExpr (oneOf " \n\r\t")

parseExpr :: Parser Expr
parseExpr =
  tryParseExpr <|>
  do char '('
     xs <- parseCode
     char ')'
     return xs
  where tryParseExpr =
          parseValues >>= valueToExpr
  
-- Types

data RunTimeError
  = NotInScope Sym
  | TypeMismatch Expr
instance Show RunTimeError where
  show x = case x of
    NotInScope y -> "Not in scope " ++ show y
    TypeMismatch y -> "Type mismatch in " ++ show y
instance Error RunTimeError

data Expr
  = Var Sym
  | Value Value
  | If Expr Expr Expr
  | Code [Expr]
    deriving Show

data Value
  = Number Integer
  | Bool Bool
  | String String
  | List [Value]
  | Func Env Sym Expr
  -- | Action IO (Maybe String)
instance Show Value where
  show x = case x of
    Number y -> show y
    Bool y -> show y
    String y -> show y
    List ys -> show $ unwords $ map show ys
    Func _ y z -> y ++ " " ++ show z
    -- Action _ -> "An action"

type Sym = String

newtype Env = Env [(Sym, Expr)]

Main.hs:54:15:
Couldn't match expected type Expr' with actual typem0 b0'
Expected type: b0 -> Expr
Actual type: b0 -> m0 b0
In the first argument of (.)', namelyreturn'
In the expression: return . Value

Main.hs:67:27:
Couldn't match expected type Text.Parsec.Prim.ParsecT String () transformers-0.2.2.0:Data.Functor.Identity.Identity b0' with actual typeExpr'
Expected type: Value
-> Text.Parsec.Prim.ParsecT
String () transformers-0.2.2.0:Data.Functor.Identity.Identity b0
Actual type: Value -> Expr
In the second argument of (>>=)', namelyvalueToExpr'
In the expression: parseValues >>= valueToExpr
cabal: Error: some packages failed to install:
lisp-0.1.0.0 failed during the building phase. The exception was:
ExitFailure 1