diff options
Diffstat (limited to 'lambda-calcul/haskell/src/Minilang/Lambda/DeBruijn.hs')
| -rw-r--r-- | lambda-calcul/haskell/src/Minilang/Lambda/DeBruijn.hs | 32 |
1 files changed, 28 insertions, 4 deletions
diff --git a/lambda-calcul/haskell/src/Minilang/Lambda/DeBruijn.hs b/lambda-calcul/haskell/src/Minilang/Lambda/DeBruijn.hs index 1d2f9e8..d3c14e3 100644 --- a/lambda-calcul/haskell/src/Minilang/Lambda/DeBruijn.hs +++ b/lambda-calcul/haskell/src/Minilang/Lambda/DeBruijn.hs @@ -5,13 +5,14 @@ module Minilang.Lambda.DeBruijn where import Data.List (elemIndex) import qualified Data.Map.Strict as Map import Data.Text (Text) -import qualified Data.Text +import qualified Data.Text as Text import Minilang.Lambda.Eval (Term) import qualified Minilang.Lambda.Eval as Eval data DeBruijn ann = FV Text | FNum Int + | FStr Text -- ^ a string literal (closed value) | FBuiltin Text -- ^ a fully-applied or partial built-in operator | Var ann Int | Lam ann (DeBruijn ann) @@ -34,6 +35,7 @@ fromDeBruijn :: DeBruijn Text -> Term fromDeBruijn = \case FV x -> Eval.Var x FNum n -> Eval.Num n + FStr s -> Eval.Str s FBuiltin b -> Eval.Var b -- reads back as a Var; eval recognises it Var s _ -> Eval.Var s Lam s body -> Eval.Lam s (fromDeBruijn body) @@ -53,6 +55,8 @@ toDeBruijn term = go term [] App (go f env) (go a env) go (Eval.Num n) _env = FNum n + go (Eval.Str s) _env = + FStr s eval :: DeBruijn ann -> DeBruijn ann eval (App f a) = @@ -66,6 +70,7 @@ eval' env = \case FV v -> case lookup v env of Just term -> term Nothing -> FV v + FStr s -> FStr s FBuiltin b -> FBuiltin b App f a -> let f' = eval' env f @@ -136,6 +141,7 @@ churchFalse = Lam "f" (Lam "t" (Var "f" 1)) -- Comparison operators return Church booleans rather than integer flags. tryReduce :: Text -> [DeBruijn Text] -> Maybe (DeBruijn Text) tryReduce name args = case (name, args) of + -- Integer arithmetic ("+", [FNum x, FNum y]) -> Just $ FNum (x + y) ("-", [FNum x, FNum y]) -> Just $ FNum (x - y) ("*", [FNum x, FNum y]) -> Just $ FNum (x * y) @@ -144,7 +150,13 @@ tryReduce name args = case (name, args) of ("=", [FNum x, FNum y]) -> Just $ if x == y then churchTrue else churchFalse ("<", [FNum x, FNum y]) -> Just $ if x < y then churchTrue else churchFalse ("neg", [FNum x]) -> Just $ FNum (negate x) - _ -> Nothing + -- String operations + ("str-concat", [FStr x, FStr y]) -> Just $ FStr (x <> y) + ("str-length", [FStr x]) -> Just $ FNum (Text.length x) + ("str-slice", [FNum i, FNum j, FStr x]) -> Just $ FStr (Text.take (j - i) (Text.drop i x)) + ("str=", [FStr x, FStr y]) -> Just $ if x == y then churchTrue else churchFalse + ("str<", [FStr x, FStr y]) -> Just $ if x < y then churchTrue else churchFalse + _ -> Nothing -- | Rebuild a left-spine application from a head and a list of arguments. rebuild :: DeBruijn Text -> [DeBruijn Text] -> DeBruijn Text @@ -156,6 +168,7 @@ substitute env n arg term = case term of Just t -> t Nothing -> FV x FNum _ -> term + FStr _ -> term FBuiltin _ -> term Var t x | x == n -> arg @@ -167,6 +180,7 @@ pretty :: DeBruijn Text -> Text pretty = \case FV x -> x FNum n -> showNum n + FStr s -> "\"" <> escapeStr s <> "\"" FBuiltin b -> b Var s _ -> s Lam s body -> "(lam (" <> s <> ") " <> pretty body <> ")" @@ -175,5 +189,15 @@ pretty = \case -- | Render an integer, using no space between '-' and digits for negative numbers. showNum :: Int -> Text showNum n - | n < 0 = "-" <> Data.Text.pack (show (abs n)) - | otherwise = Data.Text.pack (show n) + | n < 0 = "-" <> Text.pack (show (abs n)) + | otherwise = Text.pack (show n) + +-- | Escape a string for pretty-printing: wrap in double-quotes and escape +-- backslashes and double-quote characters so the output round-trips through +-- the parser. +escapeStr :: Text -> Text +escapeStr = Text.concatMap escapeChar + where + escapeChar '"' = "\\\"" + escapeChar '\\' = "\\\\" + escapeChar c = Text.singleton c |