From 6e529e74d9e1460df393e550aef897a6f6c581f1 Mon Sep 17 00:00:00 2001
From: Krasimir Angelov <kr.angelov@gmail.com>
Date: Thu, 16 Oct 2025 09:20:21 +0000
Subject: [PATCH] added the const control

---
 src/compiler/api/GF/Compile/Compute/Concrete2.hs  | 5 +++++
 src/compiler/api/GF/Compile/TypeCheck/Concrete.hs | 8 ++++++++
 src/compiler/api/GF/Grammar/Predef.hs             | 1 +
 3 files changed, 14 insertions(+)

diff --git a/src/compiler/api/GF/Compile/Compute/Concrete2.hs b/src/compiler/api/GF/Compile/Compute/Concrete2.hs
index b2c711f9b..eda69b78b 100644
--- a/src/compiler/api/GF/Compile/Compute/Concrete2.hs
+++ b/src/compiler/api/GF/Compile/Compute/Concrete2.hs
@@ -1004,6 +1004,11 @@ value2termM flat xs (VReset ctl mb_cv v mb_qid) = do
            Just cv  -> do g <- globals
                           value2termM True xs (apply g cv [VInt (genericLength ts)])
            Nothing  -> return (EInt (genericLength ts))
+      | ctl == cConst =
+          case mb_cv of
+            Just cv -> do ct <- value2termM flat xs cv
+                          msum (map (pure . const ct) ts)
+            _       -> evalError (pp "[const: .. | ..] requires an argument")
       | otherwise = evalError (pp "Operator" <+> pp ctl <+> pp "is not defined")
 
     listify mn cat [t1,t2] = do return (App (App (QC (mn,identS ("Base"++cat))) t1) t2)
diff --git a/src/compiler/api/GF/Compile/TypeCheck/Concrete.hs b/src/compiler/api/GF/Compile/TypeCheck/Concrete.hs
index 0c609e2bb..dce428643 100644
--- a/src/compiler/api/GF/Compile/TypeCheck/Concrete.hs
+++ b/src/compiler/api/GF/Compile/TypeCheck/Concrete.hs
@@ -529,6 +529,14 @@ tcRho scope c (Reset ctl mb_ct t qid) mb_ty
                          (ct,_) <- tcRho scope c2 ct (Just (VProd Explicit identW vtypeInt res_ty))
                          return (Reset ctl (Just ct) t Nothing, res_ty)
            Nothing -> instSigma scope c2 (Reset ctl Nothing t Nothing) vtypeInt mb_ty
+  | ctl == cConst = do
+      let (c1,c2) = split c
+      (t,_)      <- tcRho scope c1 t Nothing
+      (mb_ct,ty) <- case mb_ct of
+                      Just ct -> do (ct,ty) <- tcRho scope c2 ct mb_ty
+                                    return (Just ct,ty)
+                      Nothing -> evalError (pp "[list: .. | ..] requires an argument")
+      return (Reset ctl mb_ct t qid,ty)
   | otherwise = evalError (pp "Operator" <+> pp ctl <+> pp "is not defined")
 tcRho scope s (Opts n cs) mb_ty = do
   let (s1,s2,s3) = split3 s
diff --git a/src/compiler/api/GF/Grammar/Predef.hs b/src/compiler/api/GF/Grammar/Predef.hs
index c284d9033..fd80cc5b6 100644
--- a/src/compiler/api/GF/Grammar/Predef.hs
+++ b/src/compiler/api/GF/Grammar/Predef.hs
@@ -73,6 +73,7 @@ cFilter = identS "filter"
 cDefault = identS "default"
 cList = identS "list"
 cLen = identS "len"
+cConst = identS "const"
 
 cp1 = identS "p1"
 cp2 = identS "p2"