mb_new_ids <- mapM (io . go cms) (catMaybes mb_ids)
io$ updateIds cms (catMaybes mb_new_ids)
where
- -- Find the Id, clean up 'Unknowns'
+ -- Find the Id, clean up 'Unknowns' in the idType
cleanUp :: Session -> [Name] -> String -> IO (Maybe Id)
cleanUp cms newNames str = do
tythings <- GHC.parseName cms str >>= mapM (GHC.lookupName cms)
maybe (return Nothing) `flip` mb_term $ \term -> do
term' <- if not bindThings then return term
else bindSuspensions cms term
- showterm <- pprTerm cms term'
+ showterm <- printTerm cms term'
unqual <- GHC.getPrintUnqual cms
let showSDocForUserOneLine unqual doc =
showDocWith LeftMode (doc (mkErrStyle unqual))
-- A custom Term printer to enable the use of Show instances
-pprTerm cms@(Session ref) = customPrintTerm customPrint
+printTerm cms@(Session ref) = cPprTerm cPpr
where
- customPrint = \p-> customPrintShowable : customPrintTermBase p
- customPrintShowable t@Term{ty=ty, dc=dc, val=val} = do
+ cPpr = \p-> cPprShowable : cPprTermBase p
+ cPprShowable prec t@Term{ty=ty, dc=dc, val=val} = do
let hasType = isEmptyVarSet (tyVarsOfType ty) -- redundant
isEvaled = isFullyEvaluatedTerm t
if not isEvaled -- || not hasType
GHC.setSessionDynFlags cms dflags{log_action=noop_log}
mb_txt <- withExtendedLinkEnv [(bname, val)]
(GHC.compileExpr cms expr)
+ let myprec = 9 -- TODO Infix constructors
case mb_txt of
- Just txt -> return . Just . text . unsafeCoerce# $ txt
+ Just txt -> return . Just . text . unsafeCoerce#
+ $ txt
Nothing -> return Nothing
`finally` do
writeIORef ref hsc_env