Skip to content

Commit

Permalink
fix with-read desugaring to use pattern guard
Browse files Browse the repository at this point in the history
  • Loading branch information
jmcardon committed Nov 12, 2024
1 parent a8856bf commit 4ecd179
Showing 1 changed file with 5 additions and 12 deletions.
17 changes: 5 additions & 12 deletions pact/Pact/Core/Serialise/LegacyPact.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
-- |
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TemplateHaskell #-}

module Pact.Core.Serialise.LegacyPact
Expand Down Expand Up @@ -621,36 +622,28 @@ fromLegacyTerm mh = \case
fn' <- fromLegacyTerm mh fn
case fn' of
Builtin b _ -> case b of
CoreBind -> case args of
[bObj, Legacy.TBinding bps scope _] -> do
CoreBind | [bObj, Legacy.TBinding bps scope _] <- args -> do
bObj' <- fromLegacyTerm mh bObj
lam <- objBindingToLet mh bps scope
pure (App fn' [bObj', lam] ())

_ -> throwError $ "invariant failure: CoreBind"
CoreWithRead -> case args of
[tbl, rowkey, Legacy.TBinding bps scope _] -> do
CoreWithRead | [tbl, rowkey, Legacy.TBinding bps scope _] <- args -> do
tbl' <- fromLegacyTerm mh tbl
rowkey' <- fromLegacyTerm mh rowkey
lam <- objBindingToLet mh bps scope
pure (App fn' [tbl', rowkey', lam] ())

_ -> throwError "invariant failure: CoreWithRead"
CoreWithDefaultRead -> case args of
[tbl, rowkey, defaultObj, Legacy.TBinding bps scope _] -> do
CoreWithDefaultRead | [tbl, rowkey, defaultObj, Legacy.TBinding bps scope _] <- args -> do
tbl' <- fromLegacyTerm mh tbl
rowkey' <- fromLegacyTerm mh rowkey
defaultObj' <- fromLegacyTerm mh defaultObj
lam <- objBindingToLet mh bps scope
pure (App fn' [tbl', rowkey', defaultObj', lam] ())

_ -> throwError "invariant failure: CoreWithDefaultRead"
CoreResume -> case args of
[Legacy.TBinding bps scope _] -> do
CoreResume | [Legacy.TBinding bps scope _] <- args -> do
lam <- objBindingToLet mh bps scope
pure (App fn' [lam] ())

_ -> throwError "invariant failure: CoreWithRead"
-- [HOF Translation]
-- Note: The following sections of translation are explained as follows:
-- we transform, for example `(map (+ k) other-arg)` into
Expand Down

0 comments on commit 4ecd179

Please sign in to comment.