This library provides the Haskell representation and implementation of the Small Lisp SExpression type, as well as implementation of each of Small Lisp's built-in primitive library functions.

First recall the algebraic data type for Small Lisp values.

module SExpression where

import Data.Char

data SExpression = NumAtom Int | 
                   SymAtom [Char] | 
                   List [SExpression]

Now we consider how to implement the semantics of Small Lisp primitives such as first, rest, numberp and so on. In general, we provide Haskell functions to implement each primitive. The inputs to the function will be Haskell lists of SExpression values. The output will be of type Maybe SExpression to indicate that calling a Small Lisp primitive may result in an error, that is, whenever the Small Lisp reference manual defines the result as bottom (\(\bot\)).

first [List (a:more)] = Just a
first _ = Nothing

rest [List (a:more)] = Just (List more)
rest _ = Nothing

endp [List []] = Just (SymAtom "T")
endp [List _] = Just (SymAtom "F")
endp _ = Nothing

numberp [NumAtom _]  = Just (SymAtom "T")
numberp _  = Just (SymAtom "F")

symbolp [SymAtom _]  = Just (SymAtom "T")
symbolp _  = Just (SymAtom "F")

listp [List _]  = Just (SymAtom "T")
listp _  = Just (SymAtom "F")

cons [e, List es]  = Just (List (e:es))
cons _  = Nothing

eq [SymAtom n1, SymAtom n2]
    | n1 == n2    = Just (SymAtom "T")
    | otherwise   = Just (SymAtom "F")
eq _ = Nothing

plus [NumAtom n1, NumAtom n2] = Just (NumAtom (n1 + n2))
plus _ = Nothing

minus [NumAtom n1, NumAtom n2] = Just (NumAtom (n1 - n2))
minus _ = Nothing

times [NumAtom n1, NumAtom n2] = Just (NumAtom (n1 * n2))
times _ = Nothing

eqp [NumAtom n1, NumAtom n2]
    | n1 == n2    = Just (SymAtom "T")
    | otherwise   = Just (SymAtom "F")
eqp _ = Nothing

lessp [NumAtom n1, NumAtom n2]
    | n1 < n2    = Just (SymAtom "T")
    | otherwise   = Just (SymAtom "F")
lessp _ = Nothing

greaterp [NumAtom n1, NumAtom n2]
    | n1 > n2    = Just (SymAtom "T")
    | otherwise   = Just (SymAtom "F")
greaterp _ = Nothing

sym_lessp [SymAtom n1, SymAtom n2]
    | n1 < n2    = Just (SymAtom "T")
    | otherwise   = Just (SymAtom "F")
sym_lessp _ = Nothing

explode [SymAtom str] = Just (List (map explode1 str))
explode _ = Nothing

explode1 c
    | isDigit c  = NumAtom (digitToInt c)
    | otherwise  = SymAtom [c]

implode [List (SymAtom (c:chars): more)]
    | isAlpha c  = implodeAlpha (c:chars) more
    | otherwise  = implodeSpecial (c:chars) more
implode _ = Nothing

implodeAlpha str [] = Just (SymAtom str)
implodeAlpha s@(_:_) (SymAtom "-" : (SymAtom (c:chars)): more) 
    | isAlpha c  = implodeAlpha (s ++ ('-':c:chars)) more
    | otherwise  = Nothing
implodeAlpha str@(_:_) (SymAtom "-" : (NumAtom s): more) 
    | s > 0     = implodeAlpha (str ++ ('-':(show s))) more
    | otherwise = Nothing
implodeAlpha str ((SymAtom (c:chars)): more) 
    | isAlpha c  = implodeAlpha (str ++ (c:chars)) more
    | otherwise  = Nothing
implodeAlpha str ((NumAtom s): more) = implodeAlpha (str ++ (show s)) more

implodeSpecial str ((SymAtom (c:chars)): more) 
    | isAlpha c  = Nothing
    | otherwise  = implodeSpecial (str ++ (c:chars)) more
implodeSpecial _ _ = Nothing

divide [NumAtom n1, NumAtom 0] = Nothing
divide [NumAtom n1, NumAtom n2] = 
    Just (NumAtom (truncate (fromIntegral n1 / (fromIntegral n2))))
divide _ = Nothing

rem [NumAtom n1, NumAtom 0] = Nothing
rem [NumAtom n1, NumAtom n2] = 
    Just (NumAtom (n1 - (n2 * (truncate (fromIntegral n1 / (fromIntegral n2))))))
rem _ = Nothing

Showing S-Expressions

instance Show SExpression where
    show (NumAtom n) = (show n)
    show (SymAtom s) = s
    show (List []) = "()"
    show (List (a:s)) = "(" ++ show a ++ (concatMap ((' ':) . show) s) ++ ")"