diff --git a/Lambda.hs b/Lambda.hs index 513278b..16125d9 100644 --- a/Lambda.hs +++ b/Lambda.hs @@ -20,6 +20,7 @@ data Expression s = ESymbol s | ELambda s (Expression s) deriving (Show) +-- comparison checks for alpha-equivalency instance (Eq s) => Eq (Expression s) where (ESymbol a) == (ESymbol b) = a == b (EReference a) == (EReference b) = a == b @@ -27,8 +28,9 @@ instance (Eq s) => Eq (Expression s) where (ELambda _ a) == (ELambda _ b) = a == b _ == _ = False +-- Map over all the symbols in the expression (including those in the ELambdas). instance Functor Expression where - fmap f (EReference n) = EReference n + fmap f (EReference r) = EReference r fmap f (ESymbol a) = ESymbol (f a) fmap f (ELambda s e) = ELambda (f s) (fmap f e) fmap f (EExpr a b) = EExpr (fmap f a) (fmap f b) @@ -43,11 +45,13 @@ instance Functor Expression where makeUnique :: [String] -> String -> String makeUnique context s = let apostrophes = iterate ('\'' :) "" - modified = zipWith (++) (repeat s) apostrophes - available = filter (not . (`elem` context)) modified - in head available -- list of available names is infinite + modified = zipWith (++) (repeat s) apostrophes + available = filter (not . (`elem` context)) modified + in head available -- re. head: list of available names is infinite -- Expression -> Expression with unique symbol names +-- Converts all the symbols in the expression to strings and +-- then makes them unique in their context. renameUniquely :: (Show s) => Expression s -> Expression String renameUniquely = rename_ [] -- rename_ :: (Show s) => [String] -> Expression s -> Expression String @@ -57,6 +61,10 @@ renameUniquely = rename_ [] rename_ c (ELambda s e) = let name = makeUnique c . show $ s in ELambda name (rename_ (name : c) e) +-- unicode? -> Expression -> Maybe String +-- Converts the expression to a string, if possible. +-- (Not possible if a reference is too high) +-- If unicode is True, uses λ instead of \. display :: (Show s) => Bool -> Expression s -> String display unicode = d [] . renameUniquely where l = if unicode then "λ" else "\\" @@ -76,8 +84,10 @@ display unicode = d [] . renameUniquely - Evaluating expressions -} --- Expression to be inserted -> Expression to be inserted into -> result --- TODO: Make clearer what insert does - better description, ... +-- level to insert at -> Expression to be inserted +-- -> Expression to be inserted into -> result +-- Inserts an expression into another expression on a certain level. +-- The level points towards an ELambda, like an EReference. insertExpr :: Int -> Expression s -> Expression s -> Expression s insertExpr level replace ref@(EReference n) | n == level = replace @@ -85,18 +95,24 @@ insertExpr level replace ref@(EReference n) 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 +insertExpr _ _ other = other +-- Expression -> Expression applied once +-- Attempts beta-reduction, applying the leftmost expression (if there is one) to +-- the expression to its right (if there is one). +-- TODO: Apply leftmost function, not leftmost expression. apply :: Expression s -> Expression s apply (EExpr l@(ELambda s e) b) = insertExpr 0 b e apply (EExpr e@(EExpr _ _) b) = EExpr (apply e) b apply e = e +-- Takes elements as long as it hasn't seen them before. takeWhileUnique :: (Eq a) => [a] -> [a] takeWhileUnique l = map fst $ takeWhile (\a -> not $ fst a `elem` snd a) $ zip l (inits l) +-- Applies a function until there is a loop or it can't be applied any further. evaluate :: (Eq s) => Expression s -> [Expression s] evaluate = takeWhileUnique . iterate apply @@ -104,7 +120,8 @@ evaluate = takeWhileUnique . iterate apply - Parsing expressions -} --- "munchified" versions of many, many1 and chainl1 that try to match as much as possible. +-- "munchified" versions of many, many1 and chainl1 that try to match as much as +-- possible. They only match the maximum amount, not all numbers in-between. many' :: ReadP a -> ReadP [a] many' p = many1' p <++ return [] @@ -114,18 +131,22 @@ many1' p = liftM2 (:) p (many' p) chainl1' :: ReadP a -> ReadP (a -> a -> a) -> ReadP a chainl1' p f = foldl1 <$> f <*> many1' p +-- List of (opening parenthesis, closing parenthesis) pairs. parens :: [(Char, Char)] parens = [ ('(', ')') , ('[', ']') , ('{', '}') ] +-- Is opening parenthesis? isOpeningParen :: Char -> Bool isOpeningParen a = isJust $ lookup a parens +-- Is closing parenthesis to this opening parenthesis? isClosingParen :: Char -> Char -> Bool isClosingParen a b = fromMaybe False $ (== b) <$> lookup a parens +-- Put a pair of matching parentheses around a parser parenthesize :: ReadP a -> ReadP a parenthesize parser = do paren <- satisfy isOpeningParen diff --git a/interactive.hs b/interactive.hs index ce23e7c..030e363 100644 --- a/interactive.hs +++ b/interactive.hs @@ -10,6 +10,7 @@ instance Show StrSymbol where instance Eq StrSymbol where (StrSymbol a) == (StrSymbol b) = a == b +-- process a string line by line instead of all at once linewise :: (String -> String) -> String -> String linewise f = unlines . map f . lines