c3a6b5a · rowtype-yoga/purescm

git.iko.soy/rowtype-yoga/purescm

on bytevector help sign in

Inline `st`

This partly reverts `45bce2e` because we can still inline `st` even though `Effect.Ref` is no longer inlined.

commitc3a6b5a71f337942e962ea2b5fe81a44d636c881 authorAntti Holvikari <antti@anttih.com> dateMon 19 Feb 2024, 08:25 (3 years ago) parentd2522aa

2 files changed+26−6

compare with bytevector

unifiedsplit

src/PureScript/Backend/Chez/Builder.purs+4−4 src/PureScript/Backend/Chez/Convert.purs+22−2

src/PureScript/Backend/Chez/Builder.purs+4−4

@@ -60,10 +60,10 @@ basicBuildMain options = do

6060 { directives: Map.union externalDirectives (parseDirectiveFile defaultDirectives).directives

6161 , foreignSemantics: coreForeignSemantics # Map.filterKeys \(Qualified mod _) -> mod

6262 `notElem`

63− -- Filter out the PrimEffect

64− [ Just (ModuleName "Effect.Ref")

65− , Just (ModuleName "Control.Monad.ST.Internal")

66− ]

63+ -- `Effect.Ref.modify` is implemented as a thread-safe operation

64+ -- in the `refs` package. Note that `Control.Monad.ST.Internal`

65+ -- will still be inlined.

66+ [ Just (ModuleName "Effect.Ref") ]

6767 , onCodegenModule: options.onCodegenModule

6868 , onPrepareModule: options.onPrepareModule

6969 , traceIdents: Set.empty

src/PureScript/Backend/Chez/Convert.purs+22−2

@@ -28,7 +28,7 @@ import PureScript.Backend.Chez.Syntax as S

2828import PureScript.Backend.Optimizer.Convert (BackendModule, BackendBindingGroup)

2929import PureScript.Backend.Optimizer.CoreFn (Ident(..), Literal(..), ModuleName(..), Qualified(..))

3030import PureScript.Backend.Optimizer.Semantics (NeutralExpr)

31−import PureScript.Backend.Optimizer.Syntax (BackendAccessor(..), BackendOperator(..), BackendOperator1(..), BackendOperator2(..), BackendOperatorNum(..), BackendOperatorOrd(..), BackendSyntax(..), Level(..), Pair(..))

31+import PureScript.Backend.Optimizer.Syntax (BackendAccessor(..), BackendEffect(..), BackendOperator(..), BackendOperator1(..), BackendOperator2(..), BackendOperatorNum(..), BackendOperatorOrd(..), BackendSyntax(..), Level(..), Pair(..))

3232import Safe.Coerce (coerce)

3333

3434type CodegenEnv =

@@ -344,6 +344,8 @@ codegenChain chainMode codegenEnv = collect []

344344 -- `expression` has type `Effect ..`, so we can confidently unthunk here

345345 codegenEffectBind :: NeutralExpr -> ChezExpr

346346 codegenEffectBind expression = case unwrap expression of

347+ PrimEffect e' ->

348+ codegenPrimEffect codegenEnv e'

347349 UncurriedEffectApp f p ->

348350 S.runUncurriedFn (codegenExpr codegenEnv f) (codegenExpr codegenEnv <$> p)

349351 _ ->

@@ -364,6 +366,8 @@ codegenChain chainMode codegenEnv = collect []

364366 collect (Array.snoc bindings $ Tuple (toChezIdent i l) (codegenExpr codegenEnv v)) e'

365367 EffectPure e' | chainMode.effect ->

366368 finish false bindings (codegenExpr codegenEnv e')

369+ PrimEffect e' | chainMode.effect ->

370+ finish false bindings (codegenPrimEffect codegenEnv e')

367371 EffectBind i l v e' | chainMode.effect ->

368372 collect

369373 (Array.snoc bindings $ Tuple (toChezIdent i l) (codegenEffectBind v))

@@ -427,7 +431,6 @@ codegenPrimOp codegenEnv@{ currentModule } = case _ of

427431 OpGte -> comparisonExpression ">=?"

428432 OpLt -> comparisonExpression "<?"

429433 OpLte -> comparisonExpression "<=?"

430−

431434 in

432435 case o of

433436 OpArrayIndex ->

@@ -499,3 +502,20 @@ codegenPrimOp codegenEnv@{ currentModule } = case _ of

499502 OpLt -> comparisonExpression "<?"

500503 OpLte -> comparisonExpression "<=?"

501504 makeStringComparison o'

505+

506+codegenPrimEffect :: CodegenEnv -> BackendEffect NeutralExpr -> ChezExpr

507+codegenPrimEffect codegenEnv = case _ of

508+ EffectRefNew v ->

509+ S.app (S.Identifier $ scmPrefixed "box") (codegenExpr codegenEnv v)

510+ EffectRefRead r ->

511+ S.app (S.Identifier $ scmPrefixed "unbox") (codegenExpr codegenEnv r)

512+ EffectRefWrite r v ->

513+ S.List

514+ [ S.Identifier $ scmPrefixed "begin"

515+ , S.List

516+ [ S.Identifier $ scmPrefixed "set-box!"

517+ , codegenExpr codegenEnv r

518+ , codegenExpr codegenEnv v

519+ ]

520+ , S.List [ S.Identifier $ scmPrefixed "unbox", codegenExpr codegenEnv r ]

521+ ]