> module Pixley where

> import Text.ParserCombinators.Parsec
> import qualified Data.Map as Map

Definitions
===========

An environment maps names (represented as strings) to expressions.

> type Env = Map.Map String Expr

> data Expr = Symbol String
>           | Cons Expr Expr
>           | Null
>           | Boolean Bool
>           | Lambda Env Expr Expr
>           | Macro Env Expr
>     deriving (Ord, Eq)

> instance Show Expr where
>     show (Symbol s)      = s
>     show e@(Cons _ _)    = "(" ++ (showl e)
>     show Null            = "()"
>     show (Boolean True)  = "#t"
>     show (Boolean False) = "#f"
>     show (Lambda env args body) = "(lambda " ++ (show args) ++ " " ++ (show body) ++ ")"
>     show (Macro env body) = "(macro " ++ (show body) ++ ")"

> showl Null = ")"
> showl (Cons a Null) = (show a) ++ ")"
> showl (Cons a b) = (show a) ++ " " ++ (showl b)
> showl other = ". " ++ (show other) ++ ")"

Parser
======

The overall grammar of the language is:

    Expr ::= symbol | "(" {Expr} ")"

A symbol is denoted by a string which may contain only alphanumeric
characters, hyphens, underscores, and question marks.

> symbol = do
>     c <- letter
>     cs <- many (alphaNum <|> char '-' <|> char '?' <|> char '_' <|> char '*')
>     return (Symbol (c:cs))

> list = do
>     string "("
>     e <- many expr
>     spaces
>     string ")"
>     return (consFromList e)

The top-level parsing function implements the overall grammar given above.
Note that we need to give the type of this parser here -- otherwise the
type inferencer freaks out for some reason.

> expr :: Parser Expr
> expr = do
>     spaces
>     r <- (symbol <|> list)
>     return r

A convenience function for parsing Pixley programs.

> pa program = parse expr "" program

A helper function to make Cons cells from Haskell lists.

> consFromList [] =
>     Null
> consFromList (x:xs) =
>     Cons x (consFromList xs)

Evaluator
=========

> car (Cons a b) = a
> cdr (Cons a b) = b

We need to check for properly-formed lists, because that's what
Scheme and Pixley do.

> listp Null = Boolean True
> listp (Cons a b) = listp b
> listp _ = Boolean False

> eval env (Symbol s) =
>     (Map.!) env s
> eval env (Cons (Symbol "quote") (Cons sexpr Null)) =
>     sexpr
> eval env (Cons (Symbol "car") (Cons sexpr Null)) =
>     car (eval env sexpr)
> eval env (Cons (Symbol "cdr") (Cons sexpr Null)) =
>     cdr (eval env sexpr)
> eval env (Cons (Symbol "cons") (Cons sexpr1 (Cons sexpr2 Null))) =
>     Cons (eval env sexpr1) (eval env sexpr2)
> eval env (Cons (Symbol "list?") (Cons sexpr Null)) =
>     listp (eval env sexpr)
> eval env (Cons (Symbol "equal?") (Cons sexpr1 (Cons sexpr2 Null))) =
>     Boolean ((eval env sexpr1) == (eval env sexpr2))
> eval env (Cons (Symbol "let*") (Cons bindings (Cons body Null))) =
>     eval (bindAll bindings env) body
> eval env (Cons (Symbol "cond") rest) =
>     checkAll env rest
> eval env (Cons (Symbol "lambda") (Cons args (Cons body Null))) =
>     Lambda env args body

> eval env (Cons fun actuals) =
>     case eval env fun of
>         Lambda closedEnv formals body ->
>             eval (bindArgs env closedEnv formals actuals) body
>         Macro closedEnv body ->
>             let
>                 env' = Map.insert "arg" actuals closedEnv
>             in
>                 eval env' body
> eval env weirdThing =
>     error ("You can't evaluate a " ++ show weirdThing)

> checkAll env (Cons (Cons (Symbol "else") (Cons branch Null)) Null) =
>     eval env branch
> checkAll env (Cons (Cons test (Cons branch Null)) rest) =
>     case eval env test of
>         Boolean True ->
>             eval env branch
>         Boolean False ->
>             checkAll env rest

> bindAll Null env =
>     env
> bindAll (Cons binding rest) env =
>     bindAll rest (bind binding env)

> bind (Cons (Symbol sym) (Cons sexpr Null)) env =
>     Map.insert sym (eval env sexpr) env

> bindArgs env closedEnv Null Null =
>     closedEnv
> bindArgs env closedEnv (Cons (Symbol sym) formals) (Cons actual actuals) =
>     Map.insert sym (eval env actual) (bindArgs env closedEnv formals actuals)

> consFromEnvList [] =
>     Null
> consFromEnvList ((k,v):rest) =
>     Cons (Cons (Symbol k) (Cons v Null)) (consFromEnvList rest)

> envFromCons Null =
>     Map.empty
> envFromCons (Cons (Cons (Symbol k) (Cons v Null)) rest) =
>     Map.insert k v (envFromCons rest)

Top-Level Driver
================

> runPixley program =
>     let
>         Right ast = parse expr "" program
>     in
>         eval Map.empty ast