diff options
| author | Tom Smeding <tom@tomsmeding.com> | 2025-11-04 23:09:21 +0100 |
|---|---|---|
| committer | Tom Smeding <tom@tomsmeding.com> | 2025-11-04 23:09:21 +0100 |
| commit | 57779d4303f377004705c8da06a5ac46177950b2 (patch) | |
| tree | 0407089403d3d5c2de778c1aab7aed8adf2d01c0 /src/Compile.hs | |
| parent | 351667a3ff14c96a8dfe3a2f1dd76b6e1a996542 (diff) | |
Diffstat (limited to 'src/Compile.hs')
| -rw-r--r-- | src/Compile.hs | 13 |
1 files changed, 10 insertions, 3 deletions
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)) |