module PropaFP.Parsers.Lisp.DataTypes
( Frame
, Environment(..)
, Expression(..)
, addBinding
, lookupValue
, extendEnvironment
, pairToList
) where
import qualified Data.Map as Map
import qualified Data.List as List
import Prelude

-- A frame contains mappings from variable names to Lisp values.
type Frame = Map.Map String Expression

-- An Environment is a frame coupled with a parent environment.
data Environment = EmptyEnvironment
                 | Environment Frame Environment

-- The Expression data type defines the elements of the abstract syntax tree
-- and the runtime types manipulated by the Lisp system.
data Expression = Null
                | Number Rational
                | Boolean Bool
                | Variable String
                | Pair Expression Expression
                | Exception String
                | Lambda [Expression] Expression
                | PrimitiveProcedure ([Expression] -> Expression)
                | Application Expression [Expression]
                | Definition Expression Expression
                | If Expression Expression Expression
                | Cond [(Expression, Expression)]

instance Show Expression where
  show :: Expression -> String
show = Expression -> String
showExpression

instance Eq Expression where
  Expression
x == :: Expression -> Expression -> Bool
== Expression
y = Expression -> Expression -> Bool
eqExpression Expression
x Expression
y

eqExpression :: Expression -> Expression -> Bool
eqExpression :: Expression -> Expression -> Bool
eqExpression (Pair Expression
x1 Expression
x2) (Pair Expression
y1 Expression
y2) = Expression -> Expression -> Bool
eqExpression Expression
x1 Expression
y1 Bool -> Bool -> Bool
&& Expression -> Expression -> Bool
eqExpression Expression
x2 Expression
y2
eqExpression (Lambda [Expression]
x1s Expression
x2) (Lambda [Expression]
y1s Expression
y2) = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Expression -> Expression -> Bool)
-> [Expression] -> [Expression] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
List.zipWith Expression -> Expression -> Bool
eqExpression [Expression]
x1s [Expression]
y1s) Bool -> Bool -> Bool
&& Expression -> Expression -> Bool
eqExpression Expression
x2 Expression
y2
eqExpression (Application Expression
x1 [Expression]
y1s) (Application Expression
x2 [Expression]
y2s) = Expression -> Expression -> Bool
eqExpression Expression
x1 Expression
x2 Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Expression -> Expression -> Bool)
-> [Expression] -> [Expression] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
List.zipWith Expression -> Expression -> Bool
eqExpression [Expression]
y1s [Expression]
y2s)
eqExpression (Definition Expression
x1 Expression
y1) (Definition Expression
x2 Expression
y2) = Expression -> Expression -> Bool
eqExpression Expression
x1 Expression
y1 Bool -> Bool -> Bool
&& Expression -> Expression -> Bool
eqExpression Expression
x2 Expression
y2
eqExpression (If Expression
x1 Expression
y1 Expression
z1) (If Expression
x2 Expression
y2 Expression
z2) = Expression -> Expression -> Bool
eqExpression Expression
x1 Expression
y1 Bool -> Bool -> Bool
&& Expression -> Expression -> Bool
eqExpression Expression
x2 Expression
y2 Bool -> Bool -> Bool
&& Expression -> Expression -> Bool
eqExpression Expression
z1 Expression
z2
eqExpression Expression
Null Expression
Null = Bool
True
eqExpression Expression
Null Expression
_ = Bool
False
eqExpression Expression
_ Expression
Null = Bool
False
eqExpression (Number Rational
x) (Number Rational
y) = Rational
x Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
y
eqExpression (Boolean Bool
x) (Boolean Bool
y) = Bool
x Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
y
eqExpression (Variable String
x) (Variable String
y) = String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
y
eqExpression (Exception String
x) (Exception String
y) = String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
y
eqExpression Expression
_ Expression
_ = Bool
False
-- A function that recursively converts a Lisp Expression to a
-- String representation.
showExpression :: Expression -> String
showExpression :: Expression -> String
showExpression (Expression
Null) = String
"null"
showExpression (Number Rational
number) = Rational -> String
forall a. Show a => a -> String
show Rational
number
showExpression (Boolean Bool
bool)
  | Bool
bool Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True = String
"#t"
  | Bool
otherwise    = String
"#f"
showExpression (Variable String
variable) = String
variable
showExpression (Exception String
message) = String
"#Exception: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
message String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"
showExpression pair :: Expression
pair@(Pair Expression
first Expression
second)
  | Expression -> Bool
isList Expression
pair = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Expression -> String
showPairList Expression
pair) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  | Bool
otherwise = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Expression -> String
forall a. Show a => a -> String
show Expression
first) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" . " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Expression -> String
forall a. Show a => a -> String
show Expression
second) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
showExpression (Lambda [Expression]
parameters Expression
body) = String
"#CompoundProcedure"
showExpression (PrimitiveProcedure [Expression] -> Expression
_) = String
"#PrimitiveProcedure"
showExpression (Application Expression
operator [Expression]
operands) = String
"#Application " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Expression -> String
forall a. Show a => a -> String
show Expression
operator String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Expression] -> String
forall a. Show a => a -> String
show [Expression]
operands
showExpression (Definition Expression
variable Expression
value) = String
"#Definition " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Expression -> String
forall a. Show a => a -> String
show Expression
variable String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Expression -> String
forall a. Show a => a -> String
show Expression
value
showExpression Expression
_ = String
"#Unknown"

showPairList :: Expression -> String
showPairList :: Expression -> String
showPairList Expression
Null = String
""
showPairList (Pair Expression
first (Expression
Null)) = (Expression -> String
forall a. Show a => a -> String
show Expression
first)
showPairList (Pair Expression
first Expression
second) = (Expression -> String
forall a. Show a => a -> String
show Expression
first) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Expression -> String
showPairList Expression
second)

-- Helper functions for environment manipulation.
addBinding :: Environment -> String -> Expression -> Environment
addBinding :: Environment -> String -> Expression -> Environment
addBinding Environment
EmptyEnvironment String
_ Expression
_ = Environment
EmptyEnvironment
addBinding (Environment Frame
frame Environment
parent) String
name Expression
value = Frame -> Environment -> Environment
Environment Frame
newFrame Environment
parent
  where newFrame :: Frame
newFrame = String -> Expression -> Frame -> Frame
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
name Expression
value Frame
frame

lookupValue :: Environment -> String -> Expression
lookupValue :: Environment -> String -> Expression
lookupValue Environment
EmptyEnvironment String
variable = String -> Expression
Exception (String
"Binding for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
variable String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not found.")
lookupValue (Environment Frame
frame Environment
parent) String
variable =
  case Maybe Expression
value of
    Just Expression
result -> Expression
result
    Maybe Expression
Nothing     -> Environment -> String -> Expression
lookupValue Environment
parent String
variable
  where value :: Maybe Expression
value = String -> Frame -> Maybe Expression
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
variable Frame
frame

extendEnvironment :: Environment -> [Expression] -> [Expression] -> Environment
extendEnvironment :: Environment -> [Expression] -> [Expression] -> Environment
extendEnvironment Environment
environment [Expression]
parameters [Expression]
arguments =
  let params :: [String]
params = (Expression -> String) -> [Expression] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Expression -> String
forall a. Show a => a -> String
show [Expression]
parameters
  in Frame -> Environment -> Environment
Environment ([(String, Expression)] -> Frame
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([String] -> [Expression] -> [(String, Expression)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
params [Expression]
arguments)) Environment
environment

-- Helper functions for pair manipulation.
pairToList :: Expression -> [Expression]
pairToList :: Expression -> [Expression]
pairToList Expression
Null = []
pairToList (Pair Expression
first Expression
rest) = Expression
first Expression -> [Expression] -> [Expression]
forall a. a -> [a] -> [a]
: Expression -> [Expression]
pairToList Expression
rest

isList :: Expression -> Bool
isList :: Expression -> Bool
isList Expression
Null = Bool
True
isList (Pair Expression
_ Expression
second) = Expression -> Bool
isList Expression
second
isList Expression
_ = Bool
False