Remove Symbol typeclass

This commit is contained in:
Joscha 2017-11-05 17:27:48 +00:00
parent 6e09b77cc1
commit 0024751094

View file

@ -1,57 +1,37 @@
import Data.List import Data.List
data StrSymbol = StrSymbol { symBase :: String -- lowercase a to z -- A symbol denoting a variable; consists of a textual name and some (or no) apostrophes to ensure uniqueness
, symLen :: Int data Symbol = Symbol { symBase :: String -- lowercase a to z
} , symLen :: Int -- nonnegative
}
instance Show StrSymbol where instance Show Symbol where
show (StrSymbol s n) = s ++ (replicate n '\'') show (Symbol s n) = s ++ (replicate n '\'')
class Symbol a where -- Present symbols (not including symbol to change) -> symbol to change ->
-- Should we use a set instead of a list here? ~G -- unique symbol with same base and minimal amount of apostrophes
-- Hardly five minutes away and you're already overengineering. ~X findName :: [Symbol] -> Symbol -> Symbol
-- Overengineering is fun! ~G findName other (Symbol base n) =
-- Also, what is the second parameter? ~X let sameBase = filter ((base ==) . symBase) other
-- The original symbol for which a new name should be found ~G (grammer is herd) lengths = map symLen sameBase
-- Do we need that or can we just let it return a new symbol? ~X freeLengths = [0..] \\ (nub lengths)
-- If we just let it return a new symbol, we would lose the thing where something called a will be renamed to a' in Symbol base (head freeLengths) -- [0..] is infinite
-- and later back to a (keep the same name) ~G
-- How about we define a findNewName that just finds a new unique symbol that is not in the list, so we can try out both
-- things later on. ~G
findName :: [a] -> a -> a
findNewName :: [a] -> a
instance Symbol StrSymbol where
findName other (StrSymbol base n) =
let sameBase = filter ((base ==) . symBase) other
lengths = map symLen sameBase
freeLengths = [0..] \\ (nub lengths)
in StrSymbol base (head freeLengths) -- [0..] is infinite
-- findNewName basically finds a new unique base ~G
-- try to find a name in the sequence
-- a..z, aa..zz, aaa........
{-
findNewName other =
let bases = nub $ map symBase other
-}
-- An expression. Can be a mere symbol, a lambda application, or a lambda abstraction.
data Expression s = ESymbol s data Expression s = ESymbol s
| EExpr (Expression s) (Expression s) | EExpr (Expression s) (Expression s)
| ELambda s (Expression s) | ELambda s (Expression s)
instance (Show s) => Show (Expression s) where instance (Show s) => Show (Expression s) where
show (ESymbol s) = show s show (ESymbol s) = show s
-- show (EExpr a e@(EExpr _ _)) = "(" ++ show a ++ " " ++ (drop 1 $ show e) -- hack hack hack -- ((a b) c) is equivalent to (a b c)
show (EExpr a@(EExpr _ _) b) = (init $ show a) ++ " " ++ show b ++ ")" -- hack hack hack show (EExpr a@(EExpr _ _) b) = (init $ show a) ++ " " ++ show b ++ ")"
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
_s :: String -> Expression StrSymbol _s :: String -> Expression Symbol
_s s = ESymbol (StrSymbol s 0) _s s = ESymbol $ Symbol s 0
_ss :: String -> StrSymbol
_ss s = (StrSymbol s 0)
main = do main = do
print (EExpr (_s "a") (EExpr (_s "b") (_s "c"))) print (EExpr (_s "a") (EExpr (_s "b") (_s "c")))
@ -59,11 +39,12 @@ main = do
print (EExpr (EExpr (_s "a") (_s "b")) (_s "c")) print (EExpr (EExpr (_s "a") (_s "b")) (_s "c"))
print (EExpr (EExpr (EExpr (_s "a") (_s "b")) (_s "c")) (_s "d")) print (EExpr (EExpr (EExpr (_s "a") (_s "b")) (_s "c")) (_s "d"))
print (EExpr (EExpr (_s "a") (EExpr (_s "b") (_s "c"))) (_s "d")) print (EExpr (EExpr (_s "a") (EExpr (_s "b") (_s "c"))) (_s "d"))
print (ELambda (StrSymbol "a" 0) (_s "a")) print (ELambda (Symbol "a" 0) (_s "a"))
print (ELambda (StrSymbol "a" 0) (EExpr (EExpr (_s "a") (EExpr (_s "b") (_s "c"))) (_s "d"))) print (ELambda (Symbol "a" 0) (EExpr (EExpr (_s "a") (EExpr (_s "b") (_s "c"))) (_s "d")))
-- test of findName (seems to be working) ~G -- test of findName (seems to be working) ~G
print $ findName [(StrSymbol "a" 0), (StrSymbol "b" 0), (StrSymbol "a" 1)] (StrSymbol "a" 4) print $ findName [(Symbol "a" 0), (Symbol "b" 0), (Symbol "a" 1)] (Symbol "a" 4)
print $ findName [(StrSymbol "a" 0), (StrSymbol "b" 0), (StrSymbol "a" 1)] (StrSymbol "b" 3) print $ findName [(Symbol "a" 0), (Symbol "b" 0), (Symbol "a" 1)] (Symbol "b" 3)
print $ findName [(StrSymbol "a" 0), (StrSymbol "b" 0), (StrSymbol "a" 1)] (StrSymbol "c" 2) print $ findName [(Symbol "a" 0), (Symbol "b" 0), (Symbol "a" 1)] (Symbol "c" 2)
print $ findName [(StrSymbol "a" 1), (StrSymbol "a" 3), (StrSymbol "a" 0)] (StrSymbol "a" 1) print $ findName [(Symbol "a" 1), (Symbol "a" 3), (Symbol "a" 0)] (Symbol "a" 1)