From 1c6096e53a906d7821a401d91b32ca02df3d715f Mon Sep 17 00:00:00 2001
From: Boris Kolpackov <boris@codesynthesis.com>
Date: Thu, 2 Nov 2023 10:18:50 +0200
Subject: Add $first()/$second() pair functions

---
 libbuild2/functions-builtin.cxx   | 60 ++++++++++++++++++++++++++++++++++++++-
 tests/function/builtin/testscript | 25 ++++++++++++++++
 2 files changed, 84 insertions(+), 1 deletion(-)

diff --git a/libbuild2/functions-builtin.cxx b/libbuild2/functions-builtin.cxx
index 13b315c..e24ff8e 100644
--- a/libbuild2/functions-builtin.cxx
+++ b/libbuild2/functions-builtin.cxx
@@ -101,6 +101,64 @@ namespace build2
     //
     f["empty"] += [](value* v)  {return v->null || v->empty ();};
 
+
+    // $first(<value>[, <not_pair>])
+    // $second(<value>[, <not_pair>])
+    //
+    // Return the first or the second half of a pair, respectively. If a value
+    // is not a pair, then return `null` unless the <not_pair> argument is
+    // `true`, in which case return the non-pair value.
+    //
+    // If multiple pairs are specified, then return the list of first/second
+    // halfs. If an element is not a pair, then omit it from the resulting
+    // list unless the <not_pair> argument is `true`, in which case add the
+    // non-pair element to the list.
+    //
+    f["first"] += [] (names ns, optional<value> not_pair)
+    {
+      // @@ TODO: would be nice to return typed half if passed typed value.
+
+      bool np (not_pair && convert<bool> (move (*not_pair)));
+
+      names r;
+      for (auto i (ns.begin ()), e (ns.end ()); i != e; )
+      {
+        name& f (*i++);
+        name* s (f.pair ? &*i++ : nullptr);
+
+        if (s != nullptr || np)
+        {
+          f.pair = '\0';
+          r.push_back (move (f));
+        }
+        else if (ns.size () == 1)
+          return value (nullptr); // Single non-pair.
+      }
+
+      return value (move (r));
+    };
+
+    f["second"] += [] (names ns, optional<value> not_pair)
+    {
+      bool np (not_pair && convert<bool> (move (*not_pair)));
+
+      names r;
+      for (auto i (ns.begin ()), e (ns.end ()); i != e; )
+      {
+        name& f (*i++);
+        name* s (f.pair ? &*i++ : nullptr);
+
+        if (s != nullptr)
+          r.push_back (move (*s));
+        else if (np)
+          r.push_back (move (f));
+        else if (ns.size () == 1)
+          return value (nullptr); // Single non-pair.
+      }
+
+      return value (move (r));
+    };
+
     // Leave this one undocumented for now since it's unclear why would anyone
     // want to use it currently (we don't yet have any function composition
     // facilities).
@@ -110,7 +168,7 @@ namespace build2
     // $quote(<value>[, <escape>])
     //
     // Quote the value returning its string representation. If <escape> is
-    // true, then also escape (with a backslash) the quote characters being
+    // `true`, then also escape (with a backslash) the quote characters being
     // added (this is useful if the result will be re-parsed, for example as a
     // script command line).
     //
diff --git a/tests/function/builtin/testscript b/tests/function/builtin/testscript
index 714a38d..88f802a 100644
--- a/tests/function/builtin/testscript
+++ b/tests/function/builtin/testscript
@@ -55,6 +55,31 @@
   $* <'print $empty([bool] false)' >'false'  : bool
 }
 
+: first-second
+:
+{
+  $* <'print $first(a@1)'     >'a'                            : first
+  $* <'print $second(a@1)'    >'1'                            : second
+
+  $* <'print $first(@1)'     >'{}'                            : first-empty
+  $* <'print $second(a@)'    >'{}'                            : second-empty
+
+  $* <'print $first(1)'     >'[null]'                         : first-null
+  $* <'print $second(a)'    >'[null]'                         : second-null
+
+  $* <'print $first(1, true)'     >'1'                        : first-all
+  $* <'print $second(a, true)'    >'a'                        : second-all
+
+  $* <'print $first(0 a@1 b@2 c@ 4)'     >'a b c'             : firsts
+  $* <'print $second(z a@1 b@2 @3 d)'    >'1 2 3'             : seconds
+
+  $* <'print $first(0 a@1 b@2 c@ 4, true)'     >'0 a b c 4'   : firsts-all
+  $* <'print $second(z a@1 b@2 @3 d, true)'    >'z 1 2 3 d'   : seconds-all
+
+  $* <'print $first([name_pair] a@1)'     >'a'                : first-typed
+  $* <'print $second([name_pair] a@1)'    >'1'                : second-typed
+}
+
 : identity
 :
 {
-- 
cgit v1.1