From 21b44e3c55e04d7e30cc283a3f38a8d23585e8ad Mon Sep 17 00:00:00 2001
From: Krasimir Angelov <kr.angelov@gmail.com>
Date: Thu, 5 Jun 2025 11:58:25 +0000
Subject: [PATCH] control structure concat'

---
 src/compiler/api/GF/Compile/Compute/Concrete2.hs     | 9 +++++++++
 src/compiler/api/GF/Compile/TypeCheck/ConcreteNew.hs | 2 +-
 src/compiler/api/GF/Grammar/Predef.hs                | 1 +
 3 files changed, 11 insertions(+), 1 deletion(-)

diff --git a/src/compiler/api/GF/Compile/Compute/Concrete2.hs b/src/compiler/api/GF/Compile/Compute/Concrete2.hs
index 29ecfbecf..7acb76e9d 100644
--- a/src/compiler/api/GF/Compile/Compute/Concrete2.hs
+++ b/src/compiler/api/GF/Compile/Compute/Concrete2.hs
@@ -942,6 +942,15 @@ value2termM flat xs (VReset ctl mb_cv v mb_qid) = do
          case ts of
            [t] -> return t
            ts  -> return (Markup identW [] ts)
+      | ctl == cConcat' = do
+         ts <- case mb_cv of
+                 Just (VInt n) -> return (genericTake n ts)
+                 Nothing       -> return ts
+                 _             -> evalError (pp "[concat: .. | ..] requires an integer constant")
+         case ts of
+           []  -> mzero
+           [t] -> return t
+           ts  -> return (Markup identW [] ts)
       | ctl == cOne =
          case (ts,mb_cv) of
            ([]  ,Nothing) -> mzero
diff --git a/src/compiler/api/GF/Compile/TypeCheck/ConcreteNew.hs b/src/compiler/api/GF/Compile/TypeCheck/ConcreteNew.hs
index a8113618d..74c20f2ab 100644
--- a/src/compiler/api/GF/Compile/TypeCheck/ConcreteNew.hs
+++ b/src/compiler/api/GF/Compile/TypeCheck/ConcreteNew.hs
@@ -379,7 +379,7 @@ tcRho scope c (Markup tag attrs children) mb_ty = do
   res <- mapCM (\c child -> tcRho scope c child Nothing) c2 children
   instSigma scope c3 (Markup tag attrs (map fst res)) vtypeMarkup mb_ty
 tcRho scope c (Reset ctl mb_ct t qid) mb_ty
-  | ctl == cConcat = do
+  | ctl == cConcat || ctl == cConcat' = do
       let (c1,c23) = split c
           (c2,c3 ) = split c23
       (t,_) <- tcRho scope c1 t Nothing
diff --git a/src/compiler/api/GF/Grammar/Predef.hs b/src/compiler/api/GF/Grammar/Predef.hs
index 4313042fa..5f561303e 100644
--- a/src/compiler/api/GF/Grammar/Predef.hs
+++ b/src/compiler/api/GF/Grammar/Predef.hs
@@ -63,6 +63,7 @@ cError = identS "error"
 
 -- * Used in the delimited continuations
 cConcat = identS "concat"
+cConcat' = identS "concat'"
 cOne = identS "one"
 cDefault = identS "default"
 cList = identS "list"