Use Text instead of String in expressions.

master
James T. Martin 2019-12-11 19:21:54 -08:00
parent 25658f370a
commit 3fd494a398
Signed by: james
GPG Key ID: 4B7F3DA9351E577C
5 changed files with 49 additions and 29 deletions

View File

@ -2,15 +2,17 @@
module Main where
import Control.Monad (forever)
import Data.Text
import qualified Data.Text.IO as TIO
import LambdaCalculus.Expression (lazyEval)
import LambdaCalculus.Parser (parseExpression)
import System.IO (hFlush, stdout)
prompt :: String -> IO String
prompt :: Text -> IO Text
prompt text = do
putStr text
TIO.putStr text
hFlush stdout
getLine
TIO.getLine
main :: IO ()
main = forever $ parseExpression <$> prompt ">> " >>= \case

View File

@ -12,9 +12,14 @@ description: Please see the README on GitHub at <https://github.com/jame
extra-source-files:
- README.md
default-extensions:
- OverloadedStrings
dependencies:
- base >= 4.12 && < 5
- parsec >= 3.1 && < 4
- text >= 1.2 && < 2
- text-show >= 3.8 && < 4
- unordered-containers >= 0.2.10 && < 0.3
library:

View File

@ -5,33 +5,39 @@ import Data.List (elemIndex, find)
import Data.Maybe (fromJust)
import Data.HashSet (HashSet)
import qualified Data.HashSet as HS
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics (Generic)
import TextShow
data Expression
= Variable String
= Variable Text
| Application Expression Expression
| Abstraction String Expression
| Abstraction Text Expression
deriving (Eq, Generic)
instance TextShow Expression where
showb (Variable var) = fromText var
showb (Application ef ex) = "(" <> showb ef <> " " <> showb ex <> ")"
showb (Abstraction var body) = "(^" <> fromText var <> "." <> showb body <> ")"
instance Show Expression where
show (Variable var) = var
show (Application ef ex) = "(" ++ show ef ++ " " ++ show ex ++ ")"
show (Abstraction var body) = "(^" ++ var ++ "." ++ show body ++ ")"
show = T.unpack . showt
-- | Free variables are variables which are present in an expression but not bound by any abstraction.
freeVariables :: Expression -> HashSet String
freeVariables :: Expression -> HashSet Text
freeVariables (Variable variable) = HS.singleton variable
freeVariables (Application ef ex) = freeVariables ef `HS.union` freeVariables ex
freeVariables (Abstraction variable body) = HS.delete variable $ freeVariables body
-- | Return True if the given variable is free in the given expression.
freeIn :: String -> Expression -> Bool
freeIn :: Text -> Expression -> Bool
freeIn var1 (Variable var2) = var1 == var2
freeIn var (Application ef ex) = var `freeIn` ef && var `freeIn` ex
freeIn var1 (Abstraction var2 body) = var1 == var2 || var1 `freeIn` body
-- | Bound variables are variables which are bound by any abstraction in an expression.
boundVariables :: Expression -> HashSet String
boundVariables :: Expression -> HashSet Text
boundVariables (Variable _) = HS.empty
boundVariables (Application ef ex) = boundVariables ef `HS.union` boundVariables ex
boundVariables (Abstraction variable body) = HS.insert variable $ boundVariables body
@ -45,7 +51,7 @@ closed = HS.null . freeVariables
-- i.e. one can be converted to the other using only alpha-conversion.
alphaEquivalent :: Expression -> Expression -> Bool
alphaEquivalent = alphaEquivalent' [] []
where alphaEquivalent' :: [String] -> [String] -> Expression -> Expression -> Bool
where alphaEquivalent' :: [Text] -> [Text] -> Expression -> Expression -> Bool
alphaEquivalent' ctx1 ctx2 (Variable v1) (Variable v2)
-- Two variables are alpha-equivalent if they are bound in the same location.
= bindingSite ctx1 v1 == bindingSite ctx2 v2
@ -59,13 +65,13 @@ alphaEquivalent = alphaEquivalent' [] []
-- | The binding site of a variable is either the index of its binder
-- or, if it is unbound, the name of the free variable.
bindingSite :: [String] -> String -> Either String Int
bindingSite :: [Text] -> Text -> Either Text Int
bindingSite ctx var = maybeToRight var $ var `elemIndex` ctx
where maybeToRight :: b -> Maybe a -> Either b a
maybeToRight default_ = maybe (Left default_) Right
-- | Substitution is the process of replacing all free occurrences of a variable in one expression with another expression.
substitute :: String -> Expression -> Expression -> Expression
substitute :: Text -> Expression -> Expression -> Expression
substitute var1 value unmodified@(Variable var2)
| var1 == var2 = value
| otherwise = unmodified
@ -74,11 +80,17 @@ substitute var value (Application ef ex)
substitute var1 value unmodified@(Abstraction var2 body)
| var1 == var2 = unmodified
| otherwise = Abstraction var2' $ substitute var1 value $ alphaConvert var2 var2' body
where var2' = escapeName (freeVariables value) var2
where var2' :: Text
var2' = escapeName (freeVariables value) var2
alphaConvert :: Text -> Text -> Expression -> Expression
alphaConvert oldName newName expr = substitute oldName (Variable newName) expr
-- | Generate a new name which isn't present in the set, based on the old name.
escapeName :: HashSet Text -> Text -> Text
escapeName env name = fromJust $ find (not . free) names
where names = name : map ('\'' :) names
where names :: [Text]
names = name : map (`T.snoc` '\'') names
free :: Text -> Bool
free = (`HS.member` env)
-- | Returns True if the top-level expression is reducible by beta-reduction.

View File

@ -2,15 +2,17 @@ module LambdaCalculus.Parser (parseExpression) where
import Control.Applicative ((*>))
import Control.Monad (void)
import LambdaCalculus.Expression (Expression (Variable, Application, Abstraction))
import Data.Text (Text)
import qualified Data.Text as T
import LambdaCalculus.Expression
import Text.Parsec hiding (spaces)
import Text.Parsec.String
import Text.Parsec.Text
spaces :: Parser ()
spaces = void $ many1 space
variableName :: Parser String
variableName = many1 letter
variableName :: Parser Text
variableName = T.pack <$> many1 letter
variable :: Parser Expression
variable = Variable <$> variableName
@ -33,5 +35,5 @@ abstraction = do
expression :: Parser Expression
expression = abstraction <|> application <|> variable
parseExpression :: String -> Either ParseError Expression
parseExpression = parse (expression <* eof) "input"
parseExpression :: Text -> Either ParseError Expression
parseExpression code = parse (expression <* eof) "input" code

View File

@ -1,4 +1,5 @@
import Data.Char (isAlpha)
import qualified Data.Text as T
import Generic.Random (genericArbitraryRec, uniform)
import LambdaCalculus.Expression
import LambdaCalculus.Parser
@ -6,10 +7,14 @@ import Test.QuickCheck
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
import TextShow (showt)
instance Arbitrary Expression where
arbitrary = genericArbitraryRec uniform
instance Arbitrary T.Text where
arbitrary = T.pack <$> listOf1 (elements $ ['A'..'Z'] ++ ['a'..'z'])
dfi :: Expression
dfi = Application d (Application f i)
where d = Abstraction "x" $ Application (Variable "x") (Variable "x")
@ -31,13 +36,7 @@ ttttt = Application (Application (Application f t) (Abstraction "x" (Variable "x
(Variable "x")
prop_parseExpression_inverse :: Expression -> Bool
prop_parseExpression_inverse expr' = Right expr == parseExpression (show expr)
where expr = legalizeVariables expr'
legalizeVariables (Variable var) = Variable $ legalVar var
legalizeVariables (Application ef ex) = Application (legalizeVariables ef) (legalizeVariables ex)
legalizeVariables (Abstraction var body) = Abstraction (legalVar var) $ legalizeVariables body
legalVar var = 'v' : filter isAlpha var
prop_parseExpression_inverse expr = Right expr == parseExpression (showt expr)
main :: IO ()
main = defaultMain $