Upgrade to Pro — share decks privately, control downloads, hide ads and more …

Higher Order Cofree Annotation for AST

Higher Order Cofree Annotation for AST

相互再帰的なASTのために,Cofree Annotationを改良した手法の紹介です.

Avatar for Mizunashi Mana

Mizunashi Mana

November 11, 2018
Tweet

More Decks by Mizunashi Mana

Other Decks in Technology

Transcript

  1. ASTͷAnnotation data Ast a = LamAbs (Var a) (Ast a)

    a -- \x. e | App (Ast a) (Ast a) a -- e e' | FreeVar (Var a) a -- x data Var a = Var Int a -- de bruijn index • ύʔα͔ΒͷҐஔ৘ใ • ࣜͷܕ৘ใ • ࣜͷதͷࣗ༝ม਺ग़ݱ 1 / 18
  2. ASTͷAnnotating Problem class HasAnnotation f where unAnnot :: f a

    -> a instance HasAnnotation Ast where unAnnot (LamAbs _ _ x) = x unAnnot (App _ _ x) = x ... instance HasAnnotation Var where unAnnot (Var _ x) = x • ͦΕͧΕͷܕͰΠϯελϯεΛఆٛ͢Δඞཁ͕͋Δɽ • ΠϯελϯεͷύλʔϯϚον͸ɼίϯετϥΫλ౓ʹఆٛ ͢Δඞཁ͕͋Δɽ 2 / 18
  3. ૬ޓ࠶ؼΛ࢖༻ͨ͠ղܾํ๏ type Ast a = AnnotT AstR a data AstR

    a = LamAbs (Var a) (Ast a) -- \x. e | App (Ast a) (Ast a) -- e e' | FreeVar (Var a) -- x type Var a = AnnotT VarR a data VarR a = Var Int data AnnotT f a = AnnotT (f a) a unAnnot :: AnnotT f a -> a unAnnot (AnnotT _ x) = x Ξϊςʔγϣϯ৘ใΛڞ௨ͷܕίϯετϥΫλͰ؅ཧɽ 3 / 18
  4. open recursionͰͷղܾࡦ data AnnotT f a r = AnnotT (f

    r) a unAnnot :: AnnotT f a r -> a unAnnot (AnnotT _ x) = x newtype Fix f = Fix (f (Fix f)) type Ast a = Fix (AnnotT AstF a) data AstF r = LamAbs Var r | App r r | FreeVar Var newtype Var = Var Int recursion base ΛΞϊςʔγϣϯ৘ใΛ࣋ͭΑ͏ม׵ɽ 4 / 18
  5. Cofree Annotation Cofree Haskell Ͱ஌ΒΕ͍ͯΔ୅දతͳ Comonadɽ data Cofree f a

    = a :< f (Cofree f a) https://www.stackage.org/haddock/lts-12.17/free-5.0.2/ Control-Comonad-Cofree.html#t:Cofree • ଟ͘ͷσʔλܕͷجૅʹͳΔɽ • Cofree Maybe a ≃ NonEmpty a ≃ (a, [a]) • Cofree (Const b) a ≃ (a, b) • Cofree [] a ≃ Tree a • Free ͷ૒ର: ೚ҙͷ Functor f ͔Β Comonad ͕ಋग़Մೳɽ • Fix (AnnotT f a) ͱಉܕ: ͜ͷ࢖༻ํ๏͕ cofree annotation ͱݺ͹ΕΔख๏ʹͳΔɽ 5 / 18
  6. cofree annotationΛ࢖ͬͯॻ͖௚͠ unAnnot :: Ast a -> a unAnnot =

    extract type Ast = Cofree AstF data AstF r = LamAbs Var r | App r r | FreeVar Var newtype Var = Var Int • cofree ͷڞ௨ϢʔςΟϦςΟΛྲྀ༻Ͱ͖Δɽ • hoistCofree :: Functor f => (forall x. f x -> g x) -> Cofree f a -> Cofree g a ͰɼΞϊςʔγϣϯ৘ใ Λͦͷ··ʹม׵Λ࣮૷Ͱ͖Δɽ(࣮ࡍ͸ (ry) 6 / 18
  7. cofree annotation͸૬ޓ࠶ؼʹऑ͍ ҎԼΛ cofree annotation Ͱॻ͚Δ͔ʁ ॻ͜͏ͱࢥ͑͹ॻ͚Δ a ͕ɼܕ৘ใ͕ফ͑ΔͷͰ࣮༻తͰ͸ͳ͍ɽ amutumorphism

    ͱಉ͡Α͏ʹ base ͷ૊Λ࡞ͬͯ fix ͨ͠ޙࣹӨ type Expr a = AnnotT ExprR a data ExprR a = Let [Decl a] (Expr a) | NumLit Int | FreeVar Var type Decl a = AnnotT DeclR a data DeclR a = Decl Var (Expr a) data Var = Var Int 7 / 18
  8. ղܾࡦ: Higher Order Cofree Annotation ΞΠσΞ ܕ৘ใ͕ফ͑ΔͳΒɼফ͑ͳ͍Α͏ʹ recursion base ʹܕλά෇͚

    ͱ͚͹Α͘Ͷʁ • ܕλάΛ͚ͭΔ෼ͷ order Λ্͛ͨ recursion base Λߟ͑Δɽ • ैདྷͷ૊ͷ୅ΘΓʹɼܕλάͰͷ଒Λ࡞ͬͯɼͦΕΛ recursion base ʹ͢Δɽ • ޙ͸ɼܕλάΛࢦఆ͢Δ͜ͱͰܕ҆શͳࣹӨ͕Ͱ͖ΔͷͰɼ mutumorphism ͱಉ͡ recursion Λߦ͏ɽ • ܕλά͸ɼ(AST ͷΞϊςʔγϣϯͱ͚ͯͭ͠Δ) ܕ৘ใͷܕ ҆શੑʹ΋ྲྀ༻Ͱ͖Δɽ 8 / 18
  9. Higher Order Cofree Annotation data HCofree f a i =

    HCofree (f (HCofree f a) i) a unAnnot :: HCofree f a i -> a unAnnot (HCofree _ x) = x type Ast = HCofree AstF • HCofree ͸ f :: (j -> Type) -> (j -> Type) ্ͷԋࢉ ࢠ 1(Cofree ͸ f :: Type -> Type ্ͷԋࢉࢠ)ɽ • Maybe ΍ [] ͷ higher order ൛Λߟ͑Ε͹ɼHCofree Λ࢖ͬͯ ܕ҆શͳ tree ͕࡞ΕͨΓ͢Δɽ • HCofree (Compose f) a i ≃ Const (Cofree f a) i • HCofree (Sum f) a i ≃ Cofree (Either (f i)) a 1ཁ͸ؔखݍ্Ͱ initial algebra Λ୳͢΍ͭɽ 9 / 18
  10. Type EqualityΛؚΉσʔλܕ GADTs(Generalized Algebraic Data Types) • ௨ৗͷ ADT ʹՃ͑ͯɼtype

    equality ΛแؚͰ͖Δɽ • Haskell քͰ͸͜ͷ໊લͰఆணͯ͠Δ͚Ͳɼ[SP08] Ͱ࢖ΘΕͯ Δ equality quantified types ͷํ͕ػೳ͕૝૾͠΍͍͔͢΋ɽ type equality: data TypeEq a b = TypeEq (forall f. f a -> f b) typeEq :: a ~ b => TypeEq a b typeEq = TypeEq id data CTEq a b = forall c. (c ~ a, c ~ b) => CTEq fromTypeEq :: TypeEq a b -> (a ~ b => r) -> r fromTypeEq (TypeEq f) r = case f CTEq of CTEq -> r 10 / 18
  11. GADTsͷߏจ ҎԼͷ 2 ͭ͸ಉ͡σʔλܕఆٛΛද͢ɽ data D a = D1 a

    Int | D2 data D a where D1 :: a -> Int -> D a D2 :: D a GADTs ͷ৔߹ɼҎԼͷΑ͏ͳσʔλܕ΋ఆٛՄೳɽ data D a where D :: Int -> D Int -- :: forall a. (a ~ Int) => a -> D a 11 / 18
  12. GADTsΛ࢖༻ͨ͠ܕλά෇͖σʔλܕͷ࡞੒ data TagAst = TagDecl | TagExpr | TagVar |

    TagLit data ExprF r where Let :: [r 'TagDecl] -> r 'TagExpr -> ExprF r VarExpr :: r 'TagVar -> ExprF r LitExpr :: r 'TagLit -> ExprF r data DeclF r where Decl :: r 'TagVar -> r 'TagExpr -> DeclF r data VarF r where Var :: Int -> VarF r data LitF r where BoolLit :: Bool -> LitF r 12 / 18
  13. ܕλά෇͖σʔλܕʹର͢Δ଒ͷ࡞੒ data AstF r i where AstExprF :: ExprF r

    -> AstF r 'TagExpr AstDeclF :: DeclF r -> AstF r 'TagDecl AstVarF :: VarF r -> AstF r 'TagVar AstLitF :: LitF r -> AstF r 'TagLit • HCofree ͷͨΊʹɼͦΕͧΕΛ 1 ͭͷ recursion base ʹ౷߹ ͢Δɽ • higher order open union ͱ͔Λ࡞Ε͹ɼ͜͏͍͏ͷΛҰʑ࡞Δ ඞཁ΋ͳ͍ɽ • ܕλάΛ۩ମతʹࢦఆͨ͠৔߹ɼύλʔϯϚονͷ໢ཏੑ νΣοΫͰܕ΋ߟྀʹೖΕΒΕΔͨΊɼܕ҆શੑΛอࣹͬͨ ӨΛఆٛͰ͖Δɽ 13 / 18
  14. Higher Order Functor [JG08] newtype a :~> b = Nat

    { unNat :: forall i. a i -> b i } instance Category (:~>) where id = Nat id Nat f . Nat g = Nat (f . g) -- | A higher order functor -- -- > hfmap id == id -- > hfmap (f . g) == hfmap f . hfmap g -- class HFunctor f where hfmap :: a :~> b -> f a :~> f b Cofree ʹ͓͚Δ Functor ͷϢʔςΟϦςΟ͸ɼHCofree ʹ͓͍ͯ͸ ͜ͷ HFunctor Λ࢖ͬͯఆٛՄೳɽ 14 / 18
  15. Advanced HCofree ҎԼͷΑ͏ͳఆٛ΋Մೳ: data HCofree f a i = HCofree

    (f (HCofree f a) i) (a i) hunwrap :: HCofree f a :~> f (HCofree f a) hunwrap = Nat \(HCofree r _) -> r hextract :: HCofree f a :~> a hextract = Nat \(HCofree _ x) -> x hextend :: HFunctor f => (HCofree f a :~> b) -> HCofree f a :~> HCofree f b hextend (Nat f) = go where go = Nat \w -> HCofree (unNat (hfmap go . hunwrap) w) (f w) 15 / 18
  16. Advanced HCofreeͷར༻ྫ Advanced HCofree ʹ͍ͭͯ Advanced HCofree ͸ɼhigher order comonad

    ʹૉ௚ʹରԠͰ͖ɼ៉ ྷͳߏ଄Λ͍࣋ͬͯΔ͕ɼͦΕ͚ͩͰ͸ͳ࣮͘༻తʹ༗ӹɽ • ΞϊςʔγϣϯΛܕλάʹΑͬͯ෼ྨͰ͖Δɽ • higher order ͳੈքͰ׬݁Ͱ͖Δ (௨ৗͷ஋͸ɼConst ʹΑͬ ͯ higher order ͳੈքʹ࣋ͬͯ͜ΕΔ) ۩ମతͳΞϊςʔγϣϯྫ: type family HasTyp (tag :: TagAst) :: Bool where HasTyp 'TagDecl = 'False HasTyp _ = 'True data TypAnn i where TypAnn :: HasTyp i ~ 'True => TypInfo -> TypAnn i NoTypAnn :: HasTyp i ~ 'False => TypAnn i 16 / 18
  17. ·ͱΊ • cofree annotation ͸ AST ʹΞϊςʔγϣϯ৘ใΛຒΊࠐΉ৔ ߹ͷڞ௨ϢʔςΟϦςΟͱͯ͠ศརɽ • ୯ͳΔ

    cofree annotation ͸૬ޓ࠶ؼʹऑ͍ͷͰɼ૬ޓ࠶ؼ͢ Δ৔߹ higher order cofree annotation Λ࢖͏ͱྑ͍ɽ • ͦͷجຊͱͳΔΞΠσΞ͸ɼrecursion base ͷ order Λ্͛ͯܕ λάΛຒΊࠐΈɼܕ҆શͳࣹӨΛ࡞Δ͜ͱɽ • ܕλάΛຒΊࠐΉํ๏ͱͯ͠͸ɼGADTs ͕࢖͑Δɽ 17 / 18
  18. References I [JG08] Patricia Johann and Neil Ghani, Foundations for

    structured programming with GADTs, ACM SIGPLAN Notices 43 (2008), no. 1, 297. [SP08] Tim Sheard and Emir Pasalic, Meta-programming With Built-in Type Equality, Electronic Notes in Theoretical Computer Science 199 (2008), 49–65. 18 / 18