Calm me down, /prog/.

Monads make me want to die.

;-;

hurr durr haskal is hrd

--
-- Lisp.hs
--

module Lisp where

import Control.Applicative
import Data.Char

data SExpr = Number Int
           | Symbol String
           | Cons SExpr SExpr
             deriving (Show)

newtype Parse a = Parse { runParse :: [String] -> [(a, [String])] }

instance Alternative Parse where
  p1 <|> p2 = Parse $ \ts -> runParse p1 ts ++ runParse p2 ts
  empty     = Parse $ const []

instance Applicative Parse where
  p1 <*> p2 = Parse $ \ts -> do (f,ts') <- runParse p1 ts
                                (x,ts'') <- runParse p2 ts'
                                return (f x, ts'')
  pure x    = Parse $ \ts -> [(x,ts)]

instance Functor Parse where
  fmap f p = Parse $ \ts -> do (x,ts') <- runParse p ts
                               return (f x, ts')

nil :: SExpr
nil = Symbol "nil"

isIDChar :: Char -> Bool
isIDChar c = isAlphaNum c || c `elem` "+-*/<>!?"

tokens :: String -> [String]
tokens cs'@(c:cs)
  | c == ';'   = tokens $ dropWhile (/= '\n') cs
  | isSpace c  = tokens cs
  | isDigit c  = takeToken isDigit
  | isIDChar c = takeToken isIDChar
  | otherwise  = [c] : tokens cs
  where takeToken f = let (t,cs'') = span f cs' in t : tokens cs''
tokens _ = []

pDottedList :: Parse SExpr
pDottedList = mkList <$> pPar ((,) <$> pOneOrMore pExpr <* pLit "." <*> pExpr)
  where mkList (xs,x) = foldr Cons x xs

pExpr :: Parse SExpr
pExpr = pDottedList <|> pList <|> pNumber <|> pQuote <|> pSymbol

pList :: Parse SExpr
pList = foldr Cons nil <$> pPar (pZeroOrMore pExpr)

pLit :: String -> Parse String
pLit s = pSat (== s)

pNumber :: Parse SExpr
pNumber = Number <$> read <$> pSat (all isDigit)

pOneOrMore :: Parse a -> Parse [a]
pOneOrMore p = (:) <$> p <*> pZeroOrMore p

pPar :: Parse a -> Parse a
pPar p = pLit "(" *> p <* pLit ")"

pQuote :: Parse SExpr
pQuote = mkQuote <$ pLit "'" <*> pExpr
  where mkQuote e = Cons (Symbol "quote") (Cons e nil)

pSat :: (String -> Bool) -> Parse String
pSat f = Parse $ \ts ->
  case ts of
    t:ts' | f t -> [(t,ts')]
    _           -> []

pSymbol :: Parse SExpr
pSymbol = Symbol <$> pSat (all isIDChar)

pZeroOrMore :: Parse a -> Parse [a]
pZeroOrMore p = pOneOrMore p <|> pure []

parse :: String -> SExpr
parse = fst . head . filter (null . snd) . runParse pExpr . tokens

And not an IO monad in sight. It would be a lot shorter if I would just learn Parsec or something, but I'm too lazy.