Garmelon/lambda
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Compare eexpressions

Browse source
This commit is contained in:
Joscha 2017-11-05 17:34:18 +00:00
parent 8a23c2e875
commit d5bc202681
1 changed files with 11 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

12
lambda.hs
View file

@ -7,6 +7,9 @@ class (Eq s) => Symbol s where
-- simplest unique symbol -- simplest unique symbol
findName :: [s] -> s -> s findName :: [s] -> s -> s
numberUniquely :: [Int] -> s -> Int
numberUniquely context _ = head $ [1..] \\ (nub context)
-- Symbol that appends apostrophes to become unique -- Symbol that appends apostrophes to become unique
data SymApostrophe = SymApostrophe { symApoBase :: String -- lowercase a to z data SymApostrophe = SymApostrophe { symApoBase :: String -- lowercase a to z
, symApoLen :: Int -- nonnegative , symApoLen :: Int -- nonnegative
@ -53,6 +56,13 @@ instance (Show s) => Show (Expression s) where
show (EExpr a b) = "(" ++ show a ++ " " ++ show b ++ ")" show (EExpr a b) = "(" ++ show a ++ " " ++ show b ++ ")"
show (ELambda s e) = "\\" ++ show s ++ "." ++ show e show (ELambda s e) = "\\" ++ show s ++ "." ++ show e
instance (Symbol s) => Eq (Expression s) where
a == b = cmp (contextMap numberUniquely [] a) (contextMap numberUniquely [] b)
where cmp (ESymbol s1) (ESymbol s2) = s1 == s2
cmp (EExpr a1 b1) (EExpr a2 b2) = cmp a1 a2 && cmp b1 b2
cmp (ELambda s1 e1) (ELambda s2 e2) = s1 == s2 && cmp e1 e2
cmp _ _ = False
showTopLevel :: (Show s) => Expression s -> String showTopLevel :: (Show s) => Expression s -> String
showTopLevel e@(EExpr _ _) = tail . init . show $ e showTopLevel e@(EExpr _ _) = tail . init . show $ e
showTopLevel e = show e showTopLevel e = show e
@ -60,7 +70,7 @@ showTopLevel e = show e
printTopLevel :: (Show s) => Expression s -> IO () printTopLevel :: (Show s) => Expression s -> IO ()
printTopLevel = putStrLn . showTopLevel printTopLevel = putStrLn . showTopLevel
contextMap :: (Symbol s, Symbol t) => ([t] -> s -> t) -> [t] -> Expression s -> Expression t contextMap :: (Eq s, Eq t) => ([t] -> s -> t) -> [t] -> Expression s -> Expression t
contextMap f context e = helper f [] context e contextMap f context e = helper f [] context e
where helper f mapping context (ESymbol s) = ESymbol $ fromMaybe (f context s) $ lookup s mapping where helper f mapping context (ESymbol s) = ESymbol $ fromMaybe (f context s) $ lookup s mapping
helper f mapping context (EExpr a b) = EExpr (helper f mapping context a) (helper f mapping context b) helper f mapping context (EExpr a b) = EExpr (helper f mapping context a) (helper f mapping context b)