Use Text instead of String in expressions.
parent
25658f370a
commit
3fd494a398
|
@ -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
|
||||
|
|
|
@ -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:
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
13
test/Spec.hs
13
test/Spec.hs
|
@ -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 $
|
||||
|
|
Loading…
Reference in New Issue