From 705df975b043a2864b9027b1bb595a18ba98ae5f Mon Sep 17 00:00:00 2001
From: Joscha <brummer@migejolise.de>
Date: Mon, 13 Nov 2017 16:01:30 +0000
Subject: [PATCH] Document and reorganize some functions

---
 lambda.hs | 72 +++++++++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 60 insertions(+), 12 deletions(-)

diff --git a/lambda.hs b/lambda.hs
index be6b033..c8a61df 100644
--- a/lambda.hs
+++ b/lambda.hs
@@ -1,17 +1,25 @@
 import Data.List
 
+{-
+ - The Expression type
+ -}
+
 data Expression s = ESymbol s
                   | EReference Int
                   | EExpr (Expression s) (Expression s)
                   | ELambda s (Expression s)
 
+-- list of names -> name -> unique name
+-- Find a unique name not in the list of names.
+-- Appends apostrophes until name is unique.
 makeUnique :: [String] -> String -> String
 makeUnique context s =
   let apostrophes = iterate ('\'' :) ""
       modified = zipWith (++) (repeat s) apostrophes
       available = filter (not . (`elem` context)) modified
-  in head available
+  in head available -- list of available names is infinite
 
+-- Expression -> Expression with unique symbol names
 renameUniquely :: (Show s) => Expression s -> Expression String
 renameUniquely = rename_ []
   -- rename_ :: (Show s) => [String] -> Expression s -> Expression String
@@ -40,30 +48,56 @@ instance Eq (Expression s) where
   (ELambda _ a)  == (ELambda _ b)  = a == b
   _              == _              = False
 
-insertExpr :: Expression s -> Expression s -> Expression s
-insertExpr = insert_ 0
-  where insert_ level replace ref@(EReference n)
-          | n == level = replace
-          | otherwise  = ref
-        insert_ level replace (EExpr a b)   = EExpr (insert_ level replace a) (insert_ level replace b)
-        insert_ level replace (ELambda s e) = ELambda s (insert_ (level + 1) replace e)
-        insert_ _ _ symbol                  = symbol
+{-
+ - Evaluating expressions
+ -}
+
+-- Expression to be inserted -> Expression to be inserted into -> result
+-- TODO: Make clearer what insert does - better description, ...
+insertExpr :: Int -> Expression s -> Expression s -> Expression s
+insertExpr level replace ref@(EReference n)
+  | n == level = replace
+  | otherwise  = ref
+insertExpr level replace (EExpr a b)   = EExpr (insertExpr level replace a)
+                                               (insertExpr level replace b)
+insertExpr level replace (ELambda s e) = ELambda s (insertExpr (level + 1) replace e)
+insertExpr _     _       symbol        = symbol
 
 apply :: Expression s -> Expression s
-apply (EExpr l@(ELambda s e) b) = insertExpr b e
+apply (EExpr l@(ELambda s e) b) = insertExpr 0 b e
 apply (EExpr e@(EExpr _ _) b) = EExpr (apply e) b
 apply e = e
 
 takeWhileUnique :: (Eq a) => [a] -> [a]
-takeWhileUnique l = map fst $ takeWhile (\a -> not $ fst a `elem` snd a) $ zip l (inits l)
+takeWhileUnique l = map fst
+                  $ takeWhile (\a -> not $ fst a `elem` snd a)
+                  $ zip l (inits l)
 
 evaluate :: Expression s -> [Expression s]
 evaluate = takeWhileUnique . iterate apply
 
+{-
+ - Parsing expressions
+ -}
+
+-- TODO
+
+
+
+-- Helper type for using arbitrary strings as symbols
+newtype StrSymbol = StrSymbol String
+
+instance Show StrSymbol where
+  show (StrSymbol s) = s
+
+--instance Read StrSymbol where
+--  read s = StrSymbol s
+
 _s = ESymbol
 _e = EExpr
 _r = EReference
 _l = ELambda
+_ss = StrSymbol
 
 main = do
   putStrLn "Test nested expressions and parentheses"
@@ -77,11 +111,25 @@ main = do
   print (_l 1 (_e (_l 2 (_r 0)) (_l 3 (_r 1))))
   print ((_r 0) :: Expression Int) -- should also fail in some way
   putStrLn "Test insertion"
+  putStrLn "Testing Ints as symbols..."
   let t = (_l 1 (_l 2 (_r 1)))
       f = (_l 1 (_l 2 (_r 0)))
       n = (_l 1 (_e (_e (_r 0) f) t))
   print t
   print f
   print n
-  putStrLn "Evaluating..."
+  putStrLn "Evaluating... N T"
   mapM_ print . evaluate $ (_e n t)
+  putStrLn "Evaluating... N F"
+  mapM_ print . evaluate $ (_e n f)
+  putStrLn "Testing StrSymbols as symbols..."
+  let st = (_l (_ss "a") (_l (_ss "b") (_r 1)))
+      sf = (_l (_ss "a") (_l (_ss "b") (_r 0)))
+      sn = (_l (_ss "n") (_e (_e (_r 0) sf) st))
+  print st
+  print sf
+  print sn
+  putStrLn "Evaluating... N T"
+  mapM_ print . evaluate $ (_e sn st)
+  putStrLn "Evaluating... N F"
+  mapM_ print . evaluate $ (_e sn sf)