Document and reorganize some functions
This commit is contained in:
parent
6cf3c70a44
commit
705df975b0
1 changed files with 60 additions and 12 deletions
68
lambda.hs
68
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)
|
||||
{-
|
||||
- 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
|
||||
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
|
||||
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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue