Add strings handling

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