-
Notifications
You must be signed in to change notification settings - Fork 452
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
(Quasi)ABTs for syntax types #715
Conversation
@BekaValentine was right, it needs to include the argument. I have no idea what I was thinking. Co-Authored-By: Rebecca Valentine <[email protected]>
instance Eq1 Python where | ||
liftEq _ a b = case (a, b) of | ||
(Noop', Noop') -> True | ||
(Iff', Iff') -> True | ||
(Bool' b1, Bool' b2) -> b1 == b2 | ||
(String' s1, String' s2) -> s1 == s2 | ||
(Throw', Throw') -> True | ||
(Let' n1, Let' n2) -> n1 == n2 | ||
((:>>>), (:>>>)) -> True | ||
(Import' i1, Import' i2) -> i1 == i2 | ||
(Function' n1 as1, Function' n2 as2) -> n1 == n2 && as1 == as2 | ||
(Call', Call') -> True | ||
(ANil', ANil') -> True | ||
(ACons', ACons') -> True | ||
(Locate' s1, Locate' s2) -> s1 == s2 | ||
_ -> False | ||
|
||
instance Ord1 Python where | ||
liftCompare _ a b = case (a, b) of | ||
(Noop', Noop') -> EQ | ||
(Noop', _) -> LT | ||
(Iff', Iff') -> EQ | ||
(Iff', _) -> LT | ||
(Bool' b1, Bool' b2) -> compare b1 b2 | ||
(Bool' _, _) -> LT | ||
(String' s1, String' s2) -> compare s1 s2 | ||
(String' _, _) -> LT | ||
(Throw', Throw') -> EQ | ||
(Throw', _) -> LT | ||
(Let' n1, Let' n2) -> compare n1 n2 | ||
(Let' _, _) -> LT | ||
((:>>>), (:>>>)) -> EQ | ||
((:>>>), _) -> LT | ||
(Import' i1, Import' i2) -> compare i1 i2 | ||
(Import' _, _) -> LT | ||
(Function' n1 as1, Function' n2 as2) -> compare n1 n2 <> compare as1 as2 | ||
(Function' _ _, _) -> LT | ||
(Call', Call') -> EQ | ||
(Call', _) -> LT | ||
(ANil', ANil') -> EQ | ||
(ANil', _) -> LT | ||
(ACons', ACons') -> EQ | ||
(ACons', _) -> LT | ||
(Locate' s1, Locate' s2) -> compare s1 s2 | ||
(Locate' _, _) -> LT |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
We can't derive these because GHC.Generics
doesn't play well with GADTs
(or the other way around, I suppose). This is substantially worse than what we'd get using standard Fix
-based terms or even plain old data.
I'd rather do this than fuss with CI for old versions of the compiler.
🔥 that Functor constraint.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Ready for review.
-- | (Currently) untyped term representations. | ||
data Term sig v | ||
= Var v | ||
| Term (sig (Term sig v)) |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
A free monad by any other name
instance (Eq (sig (Term sig v)), Eq v) => Eq (Term sig v) where | ||
Var v1 == Var v2 = v1 == v2 | ||
Term s1 == Term s2 = s1 == s2 | ||
_ == _ = False |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
The instance head can be cleaned up (and avoid the use of UndecidableInstances
) using QuantifiedConstraints
. However:
- for
Ord
you end up needing to supply quantified constraints for bothEq
andOrd
, and - it was causing spurious CI failures for ghc9.2 and I really can't be bothered
foldTerm :: Functor sig => (v -> r) -> (sig r -> r) -> (Term sig v -> r) | ||
foldTerm var sig = mendlerTerm var (\ k -> sig . fmap k) |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Here be recursion schemes 🐉
Props to @BekaValentine for a discussion of the advantages of the approach for typed and untyped syntax. As yet we're only employing untyped syntax, but it's looking pretty reasonable.