Source code for a blog post

Lisph.hs

import Data.List

type Program = [SExp]

-- Note that we are using Strings in our compiler to denote Lisp *symbols*;
-- The Lisp we are writing has no string primitives of its own.
data SExp = Literal Integer  -- e.g. 5, 42
          | Symbol String    -- e.g. x, first, lambda, -
          | SExp [SExp]      -- e.g. (+ (* 3 2) 4), (define fact (lambda n (fact (- n 1))))

instance Show SExp where
  show (Literal n)  = show n
  show (Symbol  s)  = s
  -- show (SExp [Symbol "+", Literal 5, Literal 2]) == "(+ 5 2)"
  show (SExp exprs) = "(" ++ (intersperse ' ' $ concat $ map show exprs) ++ ")"


data Value = Number Integer 
           | List [SExp]
           | Lambda (Value -> Value)

instance Show Value where
  show (Number n) = show n
  show (List exp) = show exp
  show (Lambda f) = "<Lisp function>"


type SymbolTable = [(String, Value)]

-- read :: [Char] -> Program

-- Each SExp in the Program might update the symbol table, and also returns a value.
-- Yes, a State monad is applicable here, but it's not really necessary
-- for this exposition.
eval :: SExp -> SymbolTable -> (Value, SymbolTable)

-- If the expression is just an integer, it has no effect on the symbol table
-- but we should print out that integer.
eval (Literal n) table = (Number n, table)

eval (Symbol s)  table = 
  case (lookup s table) of
    Just value -> (value, table)
    Nothing    -> error ("The value " ++ s ++ " is not defined! Aborting.")

-- "define" is primitive construct, not a function or even a value.
-- We need to handle this case in `eval` separately so that it is handled correctly.
-- In the interest of simplicity, we will specify that "define" should be a top-level
-- expression. Something like (+ (define x 3) 4) will not update the table.
eval (SExp (Symbol "define" : Symbol s : expr : [])) table = 
  let value = fst $ eval expr table
  in
  -- Return the new value and update the symbol table, overwriting the old definition.
  (value, (s, value) : table)
  
-- "list" is also primitive, and is used to make lists.
-- Note that in real Lisps, the expression '(1 2 3) is a *reader shorthand*
-- that expands to (quote 1 2 3).
eval (SExp (Symbol "quote" : exprs)) table = (List exprs, table)

-- This one is a less straightforward!
-- To evaluate a term like `(lambda x (+ x 2))` we need to construct
-- a Haskell function of type `Value -> Value` which will associate the given
-- value with the symbol `x`. Luckily, `eval` does just that.
eval (SExp (Symbol "lambda" : Symbol s : expr : [])) table =
  let fn = \value -> fst $ eval expr ((s, value) : table)
  in
  (Lambda fn, table)

-- This is the general case, where the first value evaluates to some function
-- and we do curried function application.
eval (SExp (car : cdr)) table =
  let (fn, _) = eval car table
      args    = map fst $ map (\expr -> eval expr table) cdr
  in
  (applyRecursive fn args, table)


-- This will get us Curried function application.
applyRecursive :: Value -> [Value] -> Value
applyRecursive f args = foldr next f args where
  next (Lambda fn) value = fn value
  next not_a_function _  = error ("Cannot apply non-function " ++ (show not_a_function))


-- The expression `([], [])` corresponds to the fact that we are starting
-- with no values printed out and an empty symbol table.
repl :: Program -> [Value]
repl prog = fst $ foldr eval_and_print ([], []) prog where

  eval_and_print :: SExp -> ([Value], SymbolTable) -> ([Value], SymbolTable)
  eval_and_print expr (values, table) =
    let (newval, newtable) = eval expr table
    in
    (newval : values, newtable)

main = putStrLn $ show $ repl [Literal 5]