purescript-lua · Unisay · Jul 26, 2026 · Jul 26, 2026 · Jul 26, 2026
diff --git a/bench/goldens/fnew_Bench.RecordSet.txt b/bench/goldens/fnew_Bench.RecordSet.txt
@@ -0,0 +1,18 @@
+chunk: Bench.RecordSet.lua
+runtime: LuaJIT 2.1.1741730670
+main-chunk FNEW: 6
+function-body FNEW: 11
+total FNEW: 17
+prototypes: 18
+function-body FNEW sites:
+  Bench.RecordSet.lua:8
+  Bench.RecordSet.lua:20
+  Bench.RecordSet.lua:19
+  Bench.RecordSet.lua:30
+  Bench.RecordSet.lua:29
+  Bench.RecordSet.lua:54
+  Bench.RecordSet.lua:53
+  Bench.RecordSet.lua:52
+  Bench.RecordSet.lua:63
+  Bench.RecordSet.lua:65
+  Bench.RecordSet.lua:62
diff --git a/bench/goldens/tnew_Bench.RecordSet.txt b/bench/goldens/tnew_Bench.RecordSet.txt
@@ -0,0 +1,10 @@
+chunk: Bench.RecordSet.lua
+runtime: LuaJIT 2.1.1741730670
+main-chunk TNEW+TDUP: 5
+function-body TNEW+TDUP: 3
+total TNEW+TDUP: 8
+prototypes: 18
+function-body TNEW+TDUP sites:
+  Bench.RecordSet.lua:5 TNEW
+  Bench.RecordSet.lua:36 TNEW
+  Bench.RecordSet.lua:64 TDUP
diff --git a/bench/goldens/trace_record_set.txt b/bench/goldens/trace_record_set.txt
@@ -0,0 +1,23 @@
+spec: record_set
+runtime: LuaJIT 2.1.1741730670
+workload: n=1000000 reps=4 result=15000450000
+aborts (distinct site -- reason):
+  Bench.RecordSet.lua:29 -- NYI: bytecode FNEW
+  Bench.RecordSet.lua:30 -- NYI: bytecode FNEW
+  Bench.RecordSet.lua:38 -- inner loop in root trace
+  Bench.RecordSet.lua:62 -- NYI: bytecode FNEW
+  Bench.RecordSet.lua:63 -- NYI: bytecode FNEW
+  Bench.RecordSet.lua:65 -- NYI: bytecode UCLO
+  Bench.RecordSet.lua:8 -- NYI: bytecode FNEW
+bytecode end state (J*=compiled, I*=blacklisted):
+  Bench.RecordSet.lua:27 IFORL
+  Bench.RecordSet.lua:3 JFUNCF
+  Bench.RecordSet.lua:38 JLOOP
+  Bench.RecordSet.lua:59 IFUNCF
+  Bench.RecordSet.lua:6 JFORI
+  Bench.RecordSet.lua:6 JFORL
+  Bench.RecordSet.lua:60 JFUNCF
+  Bench.RecordSet.lua:63 JFUNCF
+  record_set.lua:21 JFORI
+  record_set.lua:21 JFORL
+counts: aborts=7 compiled=8 blacklisted=2
diff --git a/bench/macro/record_set.lua b/bench/macro/record_set.lua
@@ -0,0 +1,27 @@
+-- Record surgery on a manifest literal per element: each element builds a
+-- two-field record literal and unsafeSet copies it into a three-field
+-- record, which the fold step reads back field by field. The ideal
+-- variant builds the three-field table inline, so the gap isolates what
+-- the compiled surgery still pays per element on top of the raw build.
+return {
+  artifact = "Bench.RecordSet",
+  n = 1e6,
+  -- Ten calls of n/10 rather than one call of n: the same total work for
+  -- the timing runners, but keeps each hot-counter's bumps within one
+  -- recording attempt. See the note in array_foldl.lua.
+  drive = function(mod, n)
+    local acc
+    for _ = 1, 10 do
+      acc = mod.run(n / 10)
+    end
+    return acc
+  end,
+  ideal = function(n)
+    local acc = 0
+    for i = 1, n do
+      local r = { a = i, b = i + 1, c = i + 2 }
+      acc = acc + r.a + r.b + r.c
+    end
+    return acc
+  end,
+}
diff --git a/changelog.d/20260726_150000_unisay_record_surgery_folds.md b/changelog.d/20260726_150000_unisay_record_surgery_folds.md
@@ -0,0 +1,11 @@
+### Added
+
+- The IR optimizer folds `Record.Unsafe` surgery over statically-known
+  records, through a small handwritten registry of foreign semantics
+  complementary to the source-derived foreign lift: with a static label,
+  `unsafeGet` becomes a direct field read (collapsing to the field's value on
+  a manifest literal), and `unsafeSet`/`unsafeDelete`/`unsafeHas` on a
+  manifest record literal fold into the resulting literal or boolean — one
+  table allocation instead of two per folded copy. `Unsafe.Coerce.unsafeCoerce`
+  joins the foreign-lift allowlist, so the identity coercion beta-reduces away
+  at every applied site and its FFI table disappears from the output (#236).
diff --git a/lib/Language/PureScript/Backend/IR/Optimizer.hs b/lib/Language/PureScript/Backend/IR/Optimizer.hs
@@ -46,6 +46,7 @@ import Language.PureScript.Backend.IR.Query
   , resolveKnownCtorApp
   )
 import Language.PureScript.Backend.IR.Query qualified as Query
+import Language.PureScript.Backend.IR.RecordSurgery (foldRecordSurgery)
 import Language.PureScript.Backend.IR.SpecConstr (specConstr)
 import Language.PureScript.Backend.IR.Supply (SupplyM, freshName, runSupply)
 import Language.PureScript.Backend.IR.Types
@@ -1064,6 +1065,7 @@ optimizedExpressionWithPastes ctorTags canon pastes policy env =
     ( canonicalizeEffectHead canon
         `thenRewrite` constantFolding
         `thenRewrite` reassociateConstants
+        `thenRewrite` foldRecordSurgery
         `thenRewrite` reduceObjectProp
         `thenRewrite` reduceArrayRead
         `thenRewrite` sinkProjectionIntoLet

diff --git a/lib/Language/PureScript/Backend/IR/RecordSurgery.hs b/lib/Language/PureScript/Backend/IR/RecordSurgery.hs
@@ -0,0 +1,159 @@
+{- | Fold @Record.Unsafe@ surgery over statically-known records
+(issue #236).
+
+A handwritten semantic layer for foreign record operations,
+complementary to the source-derived lift
+("Language.PureScript.Backend.Lua.ForeignLift"): the bodies of
+@Record.Unsafe@'s exports are outside the liftable subset —
+@unsafeGet@\/@unsafeHas@ index a table by a /dynamic/ key, which has no
+IR form (a field read needs a static 'PropName'), and
+@unsafeSet@\/@unsafeDelete@ copy their record with a @pairs@ loop — so
+their semantics cannot be derived from the FFI source and are restated
+here, keyed by qualified name and application-spine shape. Unlike the
+lift, a handwritten registry /can/ drift from the package set, which is
+why it is kept this small; the golden eval oracles pin the shipped
+prelude's behaviour.
+
+Each fold restates the fork FFI
+(@purescript-lua-prelude@, @src/Record/Unsafe.lua@) at a site where
+enough is static to decide it:
+
+  * @unsafeGet l r@ /is/ @r[l]@ — with a static plain label that is
+    exactly 'ObjectProp', for any record operand: the read is the
+    call's entire body, so nothing about @r@ needs to be known. On a
+    manifest operand the sibling fold then collapses the read to the
+    field's value ('Language.PureScript.Backend.IR.Optimizer.reduceObjectProp').
+  * @unsafeSet l v r@ copies @r@ and sets @l@; on a manifest literal
+    the copy of the fresh table /is/ the extended literal, so one
+    allocation replaces two.
+  * @unsafeDelete l r@ copies @r@ dropping @l@ — on a manifest
+    literal, the literal without the field.
+  * @unsafeHas l r@ is @r[l] ~= nil@ — decidable on a manifest
+    literal, whose fields are exactly known and whose values are never
+    represented as @nil@ (the ecosystem-wide invariant that keeps
+    PureScript values storable in Lua tables; see the @unit@ entry in
+    docs\/QUIRKS.md).
+
+A record operand that is not statically known leaves the copying
+surgeries as calls. A label folds only when it is a string literal the
+Lua lowering keeps verbatim (see 'plainLabel').
+
+Like magic-do's canonical heads (Note [Canonical Effect\/ST heads]),
+recognition is by qualified name alone: a build whose @Record.Unsafe@
+is not the prelude's would be rewritten with the prelude's semantics.
+-}
+module Language.PureScript.Backend.IR.RecordSurgery
+  ( foldRecordSurgery
+  ) where
+
+import Data.Char qualified as Char
+import Data.Map.Strict qualified as Map
+import Data.Text qualified as Text
+import Language.PureScript.Backend.IR.Linker (foreignAccessorQName)
+import Language.PureScript.Backend.IR.Names
+  ( ModuleName
+  , Name (..)
+  , PropName (..)
+  , QName (..)
+  , Qualified (Imported)
+  , moduleNameFromString
+  )
+import Language.PureScript.Backend.IR.Types
+  ( Ann
+  , RawExp (..)
+  , RewriteRuleM
+  , unwindApp
+  )
+import Language.PureScript.Backend.Lua.Name qualified as Lua
+
+{- | The rewrite rule. Strictly shrinking in every arm (an application
+spine collapses into one of its operands or a literal), so it is
+fixpoint-safe; it duplicates no subexpression, preserving unique
+binders. Fires on both head shapes a foreign call has during
+optimization: a reference to the accessor binding, and the dissolved
+accessor itself — a field read off the module's @foreign@ import
+(Note [Foreign bindings structure emitted by the Linker]).
+-}
+foldRecordSurgery ∷ Applicative m ⇒ RewriteRuleM m Ann
+foldRecordSurgery =
+  pure . \case
+    expr@(AppN ann _ _)
+      | (fn, args) ← unwindApp expr
+      , Just surgery ← surgeryOf fn →
+          case (surgery, args) of
+            (Get, [label, r]) →
+              plainLabel label <&> ObjectProp ann r
+            (Set, [label, v, LiteralObject _ props]) →
+              plainLabel label <&> \prop →
+                LiteralObject ann (setField prop v props)
+            (Delete, [label, LiteralObject _ props]) →
+              plainLabel label <&> \prop →
+                LiteralObject ann (filter ((/= prop) . fst) props)
+            (Has, [label, LiteralObject _ props]) →
+              plainLabel label <&> \prop →
+                LiteralBool ann (any ((== prop) . fst) props)
+            _ → Nothing
+    _ → Nothing
+
+data Surgery = Get | Set | Delete | Has
+
+surgeryOf ∷ RawExp ann → Maybe Surgery
+surgeryOf = \case
+  Ref _ann (Imported modname name) → entryFor (QName modname name)
+  expr → foreignAccessorQName expr >>= entryFor
+ where
+  entryFor ∷ QName → Maybe Surgery
+  entryFor = (`Map.lookup` registry)
+
+  registry ∷ Map QName Surgery
+  registry =
+    Map.fromList
+      [ (QName recordUnsafe (Name "unsafeGet"), Get)
+      , (QName recordUnsafe (Name "unsafeSet"), Set)
+      , (QName recordUnsafe (Name "unsafeDelete"), Delete)
+      , (QName recordUnsafe (Name "unsafeHas"), Has)
+      ]
+
+  recordUnsafe ∷ ModuleName
+  recordUnsafe = moduleNameFromString "Record.Unsafe"
+
+{- | The label, when it is a string literal the Lua lowering keeps
+verbatim. Two conditions, both required:
+
+  * Table keys pass through 'Language.PureScript.Backend.Lua.Name.makeSafe'
+    at literal construction and at 'ObjectProp' reads, so a label
+    @makeSafe@ would rewrite (a reserved word, a non-identifier) names
+    a different key in generated tables than the raw string the
+    foreign call looks up at runtime — folding such a label would
+    change which key is read. 'Lua.fromText' succeeds exactly on the
+    labels @makeSafe@ keeps.
+  * A string literal's text is the escaped rendering
+    ('Language.PureScript.PSString.decodeStringEscaping'), while a
+    'PropName' carries the raw label; the two spellings coincide only
+    when escaping is the identity. ASCII alphanumerics and @_@ are
+    never escaped ('Lua.fromText' alone also admits non-ASCII
+    letters, which are).
+-}
+plainLabel ∷ RawExp ann → Maybe PropName
+plainLabel = \case
+  LiteralString _ann label
+    | Text.all plainChar label
+    , isJust (Lua.fromText label) →
+        Just (PropName label)
+  _ → Nothing
+ where
+  plainChar ∷ Char → Bool
+  plainChar c = Char.isAscii c && (Char.isAlphaNum c || c == '_')
+
+{- | Replace the field in place when the label is present (keeping the
+literal's field order), append it otherwise.
+-}
+setField
+  ∷ PropName
+  → RawExp ann
+  → [(PropName, RawExp ann)]
+  → [(PropName, RawExp ann)]
+setField prop v props
+  | any ((== prop) . fst) props =
+      [(p, if p == prop then v else e) | (p, e) ← props]
+  | otherwise = props <> [(prop, v)]
diff --git a/lib/Language/PureScript/Backend/Lua/ForeignLift.hs b/lib/Language/PureScript/Backend/Lua/ForeignLift.hs
@@ -140,11 +140,13 @@ import Prelude hiding (show)
 -- Allowlist -------------------------------------------------------------------
 
 {- | The foreign exports lifted into the IR: the arithmetic, comparison,
-boolean, and concatenation core of the prelude (issue #178), plus both
+boolean, and concatenation core of the prelude (issue #178), both
 halves of the @*.Uncurried@ wrappers — @run@ (issue #198) and @mk@
-(issue #227). Membership is a hard contract (see the module header): a
-listed export that fails to lift is a compile error. A broader allowlist
-is follow-up work (issue #187).
+(issue #227) — and the identity coercion @Unsafe.Coerce.unsafeCoerce@
+(issue #236), whose lifted @λx. x@ beta-reduces away at every applied
+site. Membership is a hard contract (see the module header): a listed
+export that fails to lift is a compile error. A broader allowlist is
+follow-up work (issue #187).
 
 A warning to that follow-up: do /not/ list the Effect\/ST core —
 @Effect.bindE@\/@pureE@, @Control.Monad.ST.Internal.bind_@\/@pure_@ —
@@ -183,6 +185,7 @@ allowlist =
         ]
       )
     , ("Data.Semigroup", ["concatString"])
+    , ("Unsafe.Coerce", ["unsafeCoerce"])
     , -- Both halves of the uncurried FFI wrappers: @run@ (issue #198)
       -- and @mk@ (issue #227). @runFn0@/@mkFn0@ are absent by policy,
       -- not liftability: their bodies force a /pure/ @Fn0@ with a

diff --git a/pslua.cabal b/pslua.cabal
@@ -142,6 +142,7 @@ library
     Language.PureScript.Backend.IR.Optimizer
     Language.PureScript.Backend.IR.Pass
     Language.PureScript.Backend.IR.Query
+    Language.PureScript.Backend.IR.RecordSurgery
     Language.PureScript.Backend.IR.SpecConstr
     Language.PureScript.Backend.IR.Supply
     Language.PureScript.Backend.IR.Types