From db426e85ffcb1dbfd4f8a021678d71cbbbac9dd4 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Wed, 26 Oct 2022 00:39:10 +0200 Subject: [PATCH] remove BinderInfo --- .../Compiler/Core/Extra/Recursors/Base.hs | 2 - src/Juvix/Compiler/Core/Info/BinderInfo.hs | 44 ------------------- src/Juvix/Compiler/Core/Pretty/Base.hs | 30 ++++++------- 3 files changed, 14 insertions(+), 62 deletions(-) delete mode 100644 src/Juvix/Compiler/Core/Info/BinderInfo.hs diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Base.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Base.hs index a07333e67b..17ee57087c 100644 --- a/src/Juvix/Compiler/Core/Extra/Recursors/Base.hs +++ b/src/Juvix/Compiler/Core/Extra/Recursors/Base.hs @@ -1,7 +1,6 @@ module Juvix.Compiler.Core.Extra.Recursors.Base ( module Juvix.Compiler.Core.Data.BinderList, module Juvix.Compiler.Core.Language, - module Juvix.Compiler.Core.Info.BinderInfo, module Juvix.Compiler.Core.Extra.Recursors.Collector, module Juvix.Compiler.Core.Extra.Recursors.Recur, ) @@ -10,5 +9,4 @@ where import Juvix.Compiler.Core.Data.BinderList (BinderList) import Juvix.Compiler.Core.Extra.Recursors.Collector import Juvix.Compiler.Core.Extra.Recursors.Recur -import Juvix.Compiler.Core.Info.BinderInfo import Juvix.Compiler.Core.Language diff --git a/src/Juvix/Compiler/Core/Info/BinderInfo.hs b/src/Juvix/Compiler/Core/Info/BinderInfo.hs deleted file mode 100644 index 98717952f5..0000000000 --- a/src/Juvix/Compiler/Core/Info/BinderInfo.hs +++ /dev/null @@ -1,44 +0,0 @@ -module Juvix.Compiler.Core.Info.BinderInfo where - -import Juvix.Compiler.Core.Info qualified as Info -import Juvix.Compiler.Core.Language - --- | Info about a single binder. Associated with Lambda and Pi. -newtype BinderInfo = BinderInfo {_infoBinder :: Info} - -instance IsInfo BinderInfo - -kBinderInfo :: Key BinderInfo -kBinderInfo = Proxy - --- | Info about multiple binders. Associated with LetRec. -newtype BindersInfo = BindersInfo {_infoBinders :: [Info]} - -instance IsInfo BindersInfo - -kBindersInfo :: Key BindersInfo -kBindersInfo = Proxy - -makeLenses ''BinderInfo -makeLenses ''BindersInfo - -getInfoBinder :: Info -> Info -getInfoBinder i = - case Info.lookup kBinderInfo i of - Just (BinderInfo {..}) -> _infoBinder - Nothing -> Info.empty - -getInfoBinders :: Int -> Info -> [Info] -getInfoBinders n i = - case Info.lookup kBindersInfo i of - Just (BindersInfo {..}) -> _infoBinders - Nothing -> replicate n Info.empty - -setInfoBinders :: [Info] -> Info -> Info -setInfoBinders = Info.insert . BindersInfo - -setInfoBinder :: Info -> Info -> Info -setInfoBinder = Info.insert . BinderInfo - -singletonInfoBinder :: Info -> Info -singletonInfoBinder i = setInfoBinder i mempty diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs index 11ed701d24..f3175e4aa8 100644 --- a/src/Juvix/Compiler/Core/Pretty/Base.hs +++ b/src/Juvix/Compiler/Core/Pretty/Base.hs @@ -9,9 +9,7 @@ import Data.HashMap.Strict qualified as HashMap import Juvix.Compiler.Core.Data.InfoTable import Juvix.Compiler.Core.Data.Stripped.InfoTable qualified as Stripped import Juvix.Compiler.Core.Extra -import Juvix.Compiler.Core.Info.BinderInfo import Juvix.Compiler.Core.Info.NameInfo -import Juvix.Compiler.Core.Info.TypeInfo import Juvix.Compiler.Core.Language import Juvix.Compiler.Core.Language.Stripped qualified as Stripped import Juvix.Compiler.Core.Pretty.Options @@ -191,8 +189,9 @@ ppPatterns pats = do instance PrettyCode Let where ppCode :: forall r. Member (Reader Options) r => Let -> Sem r (Doc Ann) ppCode x = do - let name = getInfoName (getInfoBinder (x ^. letInfo)) - ty = getInfoType (getInfoBinder (x ^. letInfo)) + let binder = x ^. letItem . letItemBinder + name = binder ^. binderName + ty = binder ^. binderType in do mty <- case ty of NDyn {} -> return Nothing @@ -202,24 +201,23 @@ instance PrettyCode Let where instance PrettyCode LetRec where ppCode :: forall r. Member (Reader Options) r => LetRec -> Sem r (Doc Ann) ppCode LetRec {..} = do - let n = length _letRecValues - ns <- mapM getName (getInfoBinders n _letRecInfo) + names <- mapM (getName . (^. letItemBinder)) _letRecValues vs <- mapM (ppCode . (^. letItemValue)) _letRecValues b' <- ppCode _letRecBody - return $ case ns of - [hns] -> kwLetRec <+> hns <+> kwAssign <+> head vs <+> kwIn <+> b' + return $ case names of + hns :| [] -> kwLetRec <+> hns <+> kwAssign <+> head vs <+> kwIn <+> b' _ -> let bss = indent' $ align $ concatWith (\a b -> a <> kwSemicolon <> line <> b) $ - zipWithExact (\name val -> name <+> kwAssign <+> val) ns (toList vs) - nss = enclose kwSquareL kwSquareR (concatWith (<+>) ns) + zipWithExact (\name val -> name <+> kwAssign <+> val) (toList names) (toList vs) + nss = enclose kwSquareL kwSquareR (concatWith (<+>) names) in kwLetRec <> nss <> line <> bss <> line <> kwIn <> line <> b' where - getName :: Info -> Sem r (Doc Ann) + getName :: Binder -> Sem r (Doc Ann) getName i = - case getInfoName i of + case i ^. binderName of Just name -> ppCode name Nothing -> return kwQuestion @@ -253,12 +251,12 @@ instance PrettyCode Node where NLet x -> ppCode x NRec l -> ppCode l NCase x@Case {..} -> - let branchBinderNames = map (\(CaseBranch {..}) -> map getInfoName (getInfoBinders _caseBranchBindersNum _caseBranchInfo)) _caseBranches - branchTagNames = map (\(CaseBranch {..}) -> getInfoName _caseBranchInfo) _caseBranches + let branchBinderNames = map (\CaseBranch {..} -> map (^. binderName) _caseBranchBinders) _caseBranches + branchTagNames = map (\CaseBranch {..} -> getInfoName _caseBranchInfo) _caseBranches in ppCodeCase' branchBinderNames branchTagNames x NMatch Match {..} -> do let branchPatterns = map (^. matchBranchPatterns) _matchBranches - let branchBodies = map (^. matchBranchBody) _matchBranches + branchBodies = map (^. matchBranchBody) _matchBranches pats <- mapM ppPatterns branchPatterns vs <- mapM ppCode _matchValues bs <- sequence $ zipWithExact (\ps br -> ppCode br >>= \br' -> return $ ps <+> kwMapsto <+> br') pats branchBodies @@ -266,7 +264,7 @@ instance PrettyCode Node where return $ kwMatch <+> hsep (punctuate comma (toList vs)) <+> kwWith <+> bss NPi Pi {..} -> let piType = _piBinder ^. binderType - in case getInfoName $ getInfoBinder _piInfo of + in case _piBinder ^. binderName of Just name -> do n <- ppCode name ty <- ppCode piType