Skip to content

Commit d22ed4f

Browse files
committed
Clear out some cruft from withWiredIn
Also, storing old version of code is for the VCS, not for comments...
1 parent e7d2d00 commit d22ed4f

File tree

1 file changed

+9
-30
lines changed
  • liquidhaskell-boot/src/Language/Haskell/Liquid/GHC

1 file changed

+9
-30
lines changed

liquidhaskell-boot/src/Language/Haskell/Liquid/GHC/Misc.hs

Lines changed: 9 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -44,7 +44,7 @@ import qualified Data.Text.Encoding.Error as TE
4444
import qualified Data.Text.Encoding as T
4545
import qualified Data.Text as T
4646
import Control.Arrow (second)
47-
import Control.Monad ((>=>), foldM, when)
47+
import Control.Monad ((>=>), foldM, when, forM)
4848
import qualified Text.PrettyPrint.HughesPJ as PJ
4949
import Language.Fixpoint.Types hiding (L, panic, Loc (..), SrcSpan, Constant, SESearch (..))
5050
import qualified Language.Fixpoint.Types as F
@@ -899,36 +899,18 @@ withWiredIn :: TcM a -> TcM a
899899
withWiredIn m = discardConstraints $ do
900900
-- undef <- lookupUndef
901901
wiredIns <- mkWiredIns
902-
-- snd <$> tcValBinds Ghc.NotTopLevel (binds undef wiredIns) (sigs wiredIns) m
903902
(_, _, a) <- tcValBinds Ghc.NotTopLevel [] (sigs wiredIns) m
904903
return a
905904

906905
where
907-
-- lookupUndef = do
908-
-- lookupOrig gHC_ERR (Ghc.mkVarOcc "undefined")
909-
-- -- tcLookupGlobal undefName
910-
911-
-- binds :: Name -> [TcWiredIn] -> [(Ghc.RecFlag, LHsBinds GhcRn)]
912-
-- binds undef wiredIns = map (\w ->
913-
-- let ext = Ghc.unitNameSet undef in -- $ varName $ tyThingId undef in
914-
-- let co_fn = idHsWrapper in
915-
-- let matches =
916-
-- let ctxt = LambdaExpr in
917-
-- let grhss = GRHSs Ghc.noExtField [Ghc.L locSpan (GRHS Ghc.noExtField [] (Ghc.L locSpan (HsVar Ghc.noExtField (Ghc.L locSpan undef))))] (Ghc.L locSpan emptyLocalBinds) in
918-
-- MG Ghc.noExtField (Ghc.L locSpan [Ghc.L locSpan (Match Ghc.noExtField ctxt [] grhss)]) Ghc.Generated
919-
-- in
920-
-- let b = FunBind ext (Ghc.L locSpan $ tcWiredInName w) matches co_fn [] in
921-
-- (Ghc.NonRecursive, unitBag (Ghc.L locSpan b))
922-
-- ) wiredIns
923-
924-
sigs wiredIns = concatMap (\w ->
925-
let inf = maybeToList $ (\(fPrec, fDir) -> Ghc.L locSpanAnn $ Ghc.FixSig Ghc.noAnn $ Ghc.FixitySig Ghc.NoNamespaceSpecifier [Ghc.L locSpanAnn (tcWiredInName w)] $ Ghc.Fixity Ghc.NoSourceText fPrec fDir) <$> tcWiredInFixity w in
926-
let t =
927-
let ext' = [] in
928-
[Ghc.L locSpanAnn $ TypeSig Ghc.noAnn [Ghc.L locSpanAnn (tcWiredInName w)] $ HsWC ext' $ Ghc.L locSpanAnn $ HsSig Ghc.noExtField (HsOuterImplicit ext') $ tcWiredInType w]
929-
in
930-
inf <> t
931-
) wiredIns
906+
sig w = typeSig : maybeToList fixSig
907+
where
908+
fixSig = forM (tcWiredInFixity w) $ \(fPrec, fDir) ->
909+
toLoc $ Ghc.FixSig Ghc.noAnn $ Ghc.FixitySig Ghc.NoNamespaceSpecifier [Ghc.L locSpanAnn (tcWiredInName w)] $ Ghc.Fixity Ghc.NoSourceText fPrec fDir
910+
911+
typeSig = toLoc $ TypeSig Ghc.noAnn [toLoc $ tcWiredInName w] $ HsWC [] $ toLoc $ HsSig Ghc.noExtField (HsOuterImplicit []) $ tcWiredInType w
912+
913+
sigs wiredIns = concatMap sig wiredIns
932914

933915
locSpan = UnhelpfulSpan (UnhelpfulOther "Liquid.GHC.Misc: WiredIn")
934916
locSpanAnn = noAnnSrcSpan locSpan
@@ -945,10 +927,7 @@ withWiredIn m = discardConstraints $ do
945927
toLoc = Ghc.L locSpanAnn
946928
nameToTy = Ghc.L locSpanAnn . HsTyVar Ghc.noAnn Ghc.NotPromoted
947929

948-
boolTy' :: LHsType GhcRn
949930
boolTy' = nameToTy $ toLoc boolTyConName
950-
-- boolName <- lookupOrig (Module (stringToUnitId "Data.Bool") (mkModuleName "Data.Bool")) (Ghc.mkVarOcc "Bool")
951-
-- return $ Ghc.L locSpan $ HsTyVar Ghc.noExtField Ghc.NotPromoted $ Ghc.L locSpan boolName
952931
intTy' = nameToTy $ toLoc intTyConName
953932
listTy lt = toLoc $ HsAppTy Ghc.noExtField (nameToTy $ toLoc listTyConName) lt
954933

0 commit comments

Comments
 (0)