Skip to content

Commit a2cd669

Browse files
committed
Allow matching empty sets
1 parent f66df15 commit a2cd669

File tree

1 file changed

+22
-2
lines changed

1 file changed

+22
-2
lines changed

booster/library/Booster/Pattern/Match.hs

Lines changed: 22 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -25,14 +25,15 @@ import Data.List (partition)
2525
import Data.List.NonEmpty as NE (NonEmpty, fromList)
2626
import Data.Map (Map)
2727
import Data.Map qualified as Map
28+
import Data.Maybe (isNothing)
2829
import Data.Sequence (Seq, (><), pattern (:<|), pattern (:|>))
2930
import Data.Sequence qualified as Seq
3031

3132
import Data.Set (Set)
3233
import Data.Set qualified as Set
3334
import Prettyprinter
3435

35-
import Booster.Definition.Attributes.Base (KListDefinition, KMapDefinition)
36+
import Booster.Definition.Attributes.Base (KListDefinition, KMapDefinition, KSetDefinition)
3637
import Booster.Definition.Base
3738
import Booster.Pattern.Base
3839
import Booster.Pattern.Pretty
@@ -262,7 +263,7 @@ match1 Eval t1@KSet{} t2@Injection{}
262263
match1 _ t1@KSet{} t2@Injection{} = failWith $ DifferentSymbols t1 t2
263264
match1 _ t1@KSet{} t2@KMap{} = failWith $ DifferentSymbols t1 t2
264265
match1 _ t1@KSet{} t2@KList{} = failWith $ DifferentSymbols t1 t2
265-
match1 _ t1@KSet{} t2@KSet{} = addIndeterminate t1 t2
266+
match1 _ t1@(KSet def1 patElements patRest) t2@(KSet def2 subjElements subjRest) = if def1 == def2 then matchSets def1 patElements patRest subjElements subjRest else failWith $ DifferentSorts t1 t2
266267
match1 _ t1@KSet{} t2@ConsApplication{} = failWith $ DifferentSymbols t1 t2
267268
match1 _ t1@KSet{} t2@FunctionApplication{} = addIndeterminate t1 t2
268269
match1 Rewrite t1@KSet{} (Var t2) = failWith $ SubjectVariableMatch t1 t2
@@ -626,6 +627,25 @@ containsOtherKeys = \case
626627
Rest OtherKey{} -> True
627628
Rest _ -> False
628629

630+
------ Internalised Sets
631+
matchSets ::
632+
KSetDefinition ->
633+
[Term] ->
634+
Maybe Term ->
635+
[Term] ->
636+
Maybe Term ->
637+
StateT MatchState (Except MatchResult) ()
638+
matchSets
639+
def
640+
patElements
641+
patRest
642+
subjElements
643+
subjRest = do
644+
-- match only empty sets, indeterminate otherwise
645+
if null patElements && null subjElements && isNothing patRest && isNothing subjRest
646+
then pure ()
647+
else addIndeterminate (KSet def patElements patRest) (KSet def subjElements subjRest)
648+
629649
------ Internalised Maps
630650
matchMaps ::
631651
KMapDefinition ->

0 commit comments

Comments
 (0)