From 57779d4303f377004705c8da06a5ac46177950b2 Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom@tomsmeding.com>
Date: Tue, 4 Nov 2025 23:09:21 +0100
Subject: drevLambda works, TODO D[map]

---
 src/Compile.hs | 13 ++++++++++---
 1 file changed, 10 insertions(+), 3 deletions(-)

(limited to 'src/Compile.hs')

diff --git a/src/Compile.hs b/src/Compile.hs
index d6ad7ec..8627905 100644
--- a/src/Compile.hs
+++ b/src/Compile.hs
@@ -840,11 +840,14 @@ compile' env = \case
     -- kvar <- if vecwid > 1 then genName' "k" else return ""
 
     accvar <- genName' "tot"
+    pairvar <- genName' "pair"  -- function input
+    (funres, funStmts) <- scope $ compile' (Const pairvar `SCons` env) efun
+
     let arreltlit = arrname ++ ".buf->xs[" ++ lenname ++ " * " ++ ivar ++ " + " ++
                     ({- if vecwid > 1 then show vecwid ++ " * " ++ jvar ++ " + " ++ kvar else -} jvar) ++ "]"
-    (funres, funStmts) <- scope $ compile' (Const arreltlit `SCons` Const accvar `SCons` env) efun
     ((), arreltIncrStmts) <- scope $ incrementVarAlways "foldelt" Increment t arreltlit
 
+    pairstrname <- emitStruct (STPair t t)
     emit $ SLoop (repSTy tIx) ivar (CELit "0") (CELit shszname) $
              pure (SVarDecl False (repSTy t) accvar (CELit x0name))
              <> x0incrStmts  -- we're copying x0 here
@@ -854,6 +857,7 @@ compile' env = \case
                    -- what comes out of the function anyway, so that's
                    -- fine, but we do need to increment the array element.
                    arreltIncrStmts
+                   <> pure (SVarDecl True pairstrname pairvar (CEStruct pairstrname [("a", CELit accvar), ("b", CELit arreltlit)]))
                    <> funStmts
                    <> pure (SAsg accvar funres))
              <> pure (SAsg (resname ++ ".buf->xs[" ++ ivar ++ "]") (CELit accvar))
@@ -997,12 +1001,14 @@ compile' env = \case
     jvar <- genName' "j"
 
     accvar <- genName' "tot"
+    pairvar <- genName' "pair"  -- function input
+    (funres, funStmts) <- scope $ compile' (Const pairvar `SCons` env) efun
     let eltidx = lenname ++ " * " ++ ivar ++ " + " ++ jvar
         arreltlit = arrname ++ ".buf->xs[" ++ eltidx ++ "]"
-    (funres, funStmts) <- scope $ compile' (Const arreltlit `SCons` Const accvar `SCons` env) efun
     funresvar <- genName' "res"
     ((), arreltIncrStmts) <- scope $ incrementVarAlways "foldd1elt" Increment t arreltlit
 
+    pairstrname <- emitStruct (STPair t t)
     emit $ SLoop (repSTy tIx) ivar (CELit "0") (CELit shsz1name) $
              pure (SVarDecl False (repSTy t) accvar (CELit x0name))
              <> x0incrStmts  -- we're copying x0 here
@@ -1012,8 +1018,9 @@ compile' env = \case
                    -- what comes out of the function anyway, so that's
                    -- fine, but we do need to increment the array element.
                    arreltIncrStmts
+                   <> pure (SVarDecl True pairstrname pairvar (CEStruct pairstrname [("a", CELit accvar), ("b", CELit arreltlit)]))
                    <> funStmts
-                   <> pure (SVarDecl True (repSTy (typeOf efun))  funresvar funres)
+                   <> pure (SVarDecl True (repSTy (typeOf efun)) funresvar funres)
                    <> pure (SAsg accvar (CEProj (CELit funresvar) "a"))
                    <> pure (SAsg (storesname ++ ".buf->xs[" ++ eltidx ++ "]") (CEProj (CELit funresvar) "b")))
              <> pure (SAsg (resname ++ ".buf->xs[" ++ ivar ++ "]") (CELit accvar))
-- 
cgit v1.2.3-70-g09d2