diff --git a/src/Core/Parse/Types.hs b/src/Core/Parse/Types.hs index 0b5c264..5456b4f 100644 --- a/src/Core/Parse/Types.hs +++ b/src/Core/Parse/Types.hs @@ -54,5 +54,5 @@ type PsName = Either Name Var -------------------------------------------------------------------------------- finishTyping :: Program PsName -> P (Program Var) -finishTyping = error . show +finishTyping = traverseOf binders undefined diff --git a/src/Core/Syntax.hs b/src/Core/Syntax.hs index 714aa4d..d444579 100644 --- a/src/Core/Syntax.hs +++ b/src/Core/Syntax.hs @@ -2,7 +2,6 @@ Module : Core.Syntax Description : Core ASTs and the like -} --- {-# OPTIONS_GHC -freduction-depth=0 #-} {-# LANGUAGE PatternSynonyms, OverloadedStrings #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE TemplateHaskell #-} @@ -51,6 +50,7 @@ import Data.HashMap.Strict qualified as H import Data.Hashable import Data.Foldable (traverse_) import Data.Functor +import Data.Monoid import Data.Functor.Classes import Data.Text qualified as T import Data.Char @@ -500,9 +500,21 @@ deriving instance Lift b => Lift (Program b) class HasBinders s t a b | s -> a, t -> b, s b -> t, t a -> s where binders :: Traversal s t a b --- instance (HasBinders a a' b b') --- => HasBinders (ExprF b a) (ExprF b' a') b b' where --- binders k = undefined +instance HasBinders (ScDef b) (ScDef b') b b' where + binders k (ScDef b as e) = ScDef <$> k b <*> traverse k as <*> binders k e + +instance (Hashable b, Hashable b') + => HasBinders (Program b) (Program b') b b' where + binders :: forall f. (Applicative f) + => LensLike f (Program b) (Program b') b b' + binders k p + = Program + <$> traverse (binders k) (_programScDefs p) + <*> (getAp . ifoldMap toSingleton $ _programTypeSigs p) + <*> pure (_programDataTags p) + where + toSingleton :: b -> Type -> Ap f (HashMap b' Type) + toSingleton b t = Ap $ (`H.singleton` t) <$> k b instance HasBinders a a' b b' => HasBinders (ExprF b a) (ExprF b' a') b b' where