From a1e0b0e5071f851c865ae567de7a28014a1eafc4 Mon Sep 17 00:00:00 2001
From: Arnaud Bailly <arnaud@pankzsoft.com>
Date: Sun, 22 Mar 2026 16:05:42 +0100
Subject: Add strings handling

---
 lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs | 37 +++++++++++++++++------
 1 file changed, 28 insertions(+), 9 deletions(-)

(limited to 'lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs')

diff --git a/lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs b/lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs
index 324c881..104fddc 100644
--- a/lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs
+++ b/lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs
@@ -8,6 +8,7 @@ import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import Data.String (IsString (..))
 import Data.Text (Text, pack)
+import qualified Data.Text as Text
 import GHC.Generics (Generic)
 
 data Term
@@ -15,6 +16,7 @@ data Term
   | Lam Text Term
   | App Term Term
   | Num Int
+  | Str Text
   deriving (Show, Read, Eq, Generic, ToJSON, FromJSON)
 
 instance IsString Term where
@@ -27,10 +29,11 @@ data Value
   = Clos EnvValue Text Term
   | VNeut Neutral
   | VNum Int
+  | VStr Text
   | Builtin Text Int [Value]
   deriving (Show, Read, Eq)
 
-data Neutral = NVar Text | NNum Int | NApp Neutral Value
+data Neutral = NVar Text | NNum Int | NStr Text | NApp Neutral Value
   deriving (Show, Read, Eq)
 
 type Env = [(Text, Term)]
@@ -43,14 +46,19 @@ newEnv = []
 -- | Arity table for every built-in operator.
 builtinArity :: Map Text Int
 builtinArity = Map.fromList
-  [ ("+",   2)
-  , ("-",   2)
-  , ("*",   2)
-  , ("div", 2)
-  , ("mod", 2)
-  , ("=",   2)
-  , ("<",   2)
-  , ("neg", 1)
+  [ ("+",          2)
+  , ("-",          2)
+  , ("*",          2)
+  , ("div",        2)
+  , ("mod",        2)
+  , ("=",          2)
+  , ("<",          2)
+  , ("neg",        1)
+  , ("str-concat", 2)
+  , ("str-length", 1)
+  , ("str-slice",  3)
+  , ("str=",       2)
+  , ("str<",       2)
   ]
 
 -- | The set of built-in names, for fast membership testing.
@@ -77,6 +85,7 @@ eval env = \case
         a' = eval env a
      in f' `seq` a' `seq` apply f' a'
   Num n -> VNum n
+  Str s -> VStr s
 
 apply :: Value -> Value -> Value
 apply f a =
@@ -86,6 +95,7 @@ apply f a =
        in eval env' body
     VNeut f' -> VNeut (NApp f' a)
     VNum n   -> VNeut (NApp (NNum n) a)
+    VStr s   -> VNeut (NApp (NStr s) a)
     -- Last argument arrives: dispatch and reduce.
     Builtin name 1 args -> dispatchBuiltin name (args ++ [a])
     -- Still waiting for more arguments: accumulate.
@@ -105,6 +115,7 @@ churchFalse = Clos builtinEnvValue "f" (Lam "t" (Var "f"))
 -- Comparison operators (= and <) return Church booleans rather than integers.
 dispatchBuiltin :: Text -> [Value] -> Value
 dispatchBuiltin name args = case (name, args) of
+  -- Integer arithmetic
   ("+",   [VNum x, VNum y]) -> VNum (x + y)
   ("-",   [VNum x, VNum y]) -> VNum (x - y)
   ("*",   [VNum x, VNum y]) -> VNum (x * y)
@@ -115,6 +126,12 @@ dispatchBuiltin name args = case (name, args) of
   ("=",   [VNum x, VNum y]) -> if x == y then churchTrue else churchFalse
   ("<",   [VNum x, VNum y]) -> if x <  y then churchTrue else churchFalse
   ("neg", [VNum x])         -> VNum (negate x)
+  -- String operations
+  ("str-concat", [VStr x, VStr y])           -> VStr (x <> y)
+  ("str-length", [VStr x])                   -> VNum (Text.length x)
+  ("str-slice",  [VNum i, VNum j, VStr x])   -> VStr (Text.take (j - i) (Text.drop i x))
+  ("str=",       [VStr x, VStr y])           -> if x == y then churchTrue else churchFalse
+  ("str<",       [VStr x, VStr y])           -> if x <  y then churchTrue else churchFalse
   -- Stuck: reconstruct a neutral application chain rooted at the builtin name.
   _ -> foldl (\acc v -> VNeut (NApp (neutralOf acc) v)) (VNeut (NVar name)) args
   where
@@ -132,8 +149,10 @@ readBack = go []
          in Lam name (go names' val')
       VNeut (NVar n)    -> Var n
       VNeut (NNum n)    -> Num n
+      VNeut (NStr s)    -> Str s
       VNeut (NApp f a)  -> App (go names (VNeut f)) (go names a)
       VNum n            -> Num n
+      VStr s            -> Str s
       -- A partial builtin reads back as a chain of applications rooted at
       -- the builtin name, e.g. Builtin "+" 1 [VNum 3]  →  App (Var "+") (Num 3)
       Builtin bname _ accumulated ->
-- 
cgit v1.3.1