X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FHscMain.lhs;h=b174e5e419b37854a69c0349dd48c63c8902b6a0;hb=de1d4a16d94fa13e9d40a1ac755eae6249595e66;hp=b5085cdbd183da5ac4ddb59c6ef048442280f4da;hpb=9e93335020e64a811dbbb223e1727c76933a93ae;p=ghc-hetmet.git diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs index b5085cd..b174e5e 100644 --- a/ghc/compiler/main/HscMain.lhs +++ b/ghc/compiler/main/HscMain.lhs @@ -5,9 +5,9 @@ \section[GHC_Main]{Main driver for Glasgow Haskell compiler} \begin{code} -module HscMain ( HscResult(..), hscMain, +module HscMain ( HscResult(..), hscMain, #ifdef GHCI - hscStmt, hscThing, + hscStmt, hscThing, hscModuleContents, #endif initPersistentCompilerState ) where @@ -16,9 +16,9 @@ module HscMain ( HscResult(..), hscMain, #ifdef GHCI import Interpreter import ByteCodeGen ( byteCodeGen ) -import CoreTidy ( tidyCoreExpr ) +import TidyPgm ( tidyCoreExpr ) import CorePrep ( corePrepExpr ) -import Rename ( renameStmt, renameRdrName ) +import Rename ( renameStmt, renameRdrName, slurpIface ) import RdrName ( rdrNameOcc, setRdrNameOcc ) import RdrHsSyn ( RdrNameStmt ) import OccName ( dataName, tcClsName, @@ -26,11 +26,15 @@ import OccName ( dataName, tcClsName, import Type ( Type ) import Id ( Id, idName, setGlobalIdDetails ) import IdInfo ( GlobalIdDetails(VanillaGlobal) ) -import HscTypes ( InteractiveContext(..) ) +import Name ( isInternalName ) +import NameEnv ( lookupNameEnv ) +import Module ( lookupModuleEnv ) +import RdrName ( rdrEnvElts ) import PrelNames ( iNTERACTIVE ) import StringBuffer ( stringToStringBuffer ) -import FastString ( mkFastString ) import Maybes ( catMaybes ) + +import List ( nub ) #endif import HsSyn @@ -40,33 +44,35 @@ import Id ( idName ) import IdInfo ( CafInfo(..), CgInfoEnv, CgInfo(..) ) import StringBuffer ( hGetStringBuffer, freeStringBuffer ) import Parser -import Lex ( PState(..), ParseResult(..) ) +import Lex ( ParseResult(..), ExtFlags(..), mkPState ) import SrcLoc ( mkSrcLoc ) import Finder ( findModule ) -import Rename ( checkOldIface, renameModule, closeIfaceDecls ) +import Rename ( checkOldIface, renameModule, renameExtCore, + closeIfaceDecls, RnResult(..) ) import Rules ( emptyRuleBase ) import PrelInfo ( wiredInThingEnv, wiredInThings ) import PrelRules ( builtinRules ) -import PrelNames ( knownKeyNames ) +import PrelNames ( knownKeyNames, gHC_PRIM_Name ) import MkIface ( mkFinalIface ) import TcModule import InstEnv ( emptyInstEnv ) import Desugar +import Flattening ( flatten, flattenExpr ) import SimplCore import CoreUtils ( coreBindsSize ) -import CoreTidy ( tidyCorePgm ) +import TidyPgm ( tidyCorePgm ) import CorePrep ( corePrepPgm ) import StgSyn import CoreToStg ( coreToStg ) import SimplStg ( stg2stg ) import CodeGen ( codeGen ) -import CodeOutput ( codeOutput ) +import CodeOutput ( codeOutput, outputForeignStubs ) -import Module ( ModuleName, moduleName, mkHomeModule, - moduleUserString ) +import Module ( ModuleName, moduleName, mkHomeModule ) import CmdLineOpts +import DriverState ( v_HCHeader ) +import DriverPhases ( isExtCore_file ) import ErrUtils ( dumpIfSet_dyn, showPass, printError ) -import Util ( unJust ) import UniqSupply ( mkSplitUniqSupply ) import Bag ( consBag, emptyBag ) @@ -75,17 +81,24 @@ import HscStats ( ppSourceStats ) import HscTypes import FiniteMap ( FiniteMap, plusFM, emptyFM, addToFM ) import OccName ( OccName ) -import Name ( Name, nameModule, nameOccName, getName, isGlobalName ) +import Name ( Name, nameModule, nameOccName, getName ) import NameEnv ( emptyNameEnv, mkNameEnv ) import Module ( Module ) +import FastString +import Maybes ( expectJust ) +import Util ( seqList ) -import IOExts ( newIORef, readIORef, writeIORef, unsafePerformIO ) +import IOExts ( newIORef, readIORef, writeIORef, + unsafePerformIO ) import Monad ( when ) import Maybe ( isJust, fromJust ) import IO import MkExternalCore ( emitExternalCore ) +import ParserCore +import ParserCoreUtils + \end{code} @@ -133,14 +146,15 @@ hscMain hscMain ghci_mode dflags mod location source_unchanged have_object maybe_old_iface hst hit pcs - = do { + = {-# SCC "hscMain" #-} + do { showPass dflags ("Checking old interface for hs = " ++ show (ml_hs_file location) ++ ", hspp = " ++ show (ml_hspp_file location)); (pcs_ch, errs_found, (recomp_reqd, maybe_checked_iface)) <- _scc_ "checkOldIface" - checkOldIface ghci_mode dflags hit hst pcs (ml_hi_file location) + checkOldIface ghci_mode dflags hit hst pcs mod (ml_hi_file location) source_unchanged maybe_old_iface; if errs_found then @@ -170,7 +184,7 @@ hscNoRecomp ghci_mode dflags have_object = do { when (verbosity dflags >= 1) $ hPutStrLn stderr ("Skipping " ++ - compMsg have_object mod location); + showModMsg have_object mod location); -- CLOSURE (pcs_cl, closure_errs, cl_hs_decls) @@ -190,75 +204,51 @@ hscNoRecomp ghci_mode dflags have_object return (HscNoRecomp pcs_tc new_details old_iface) }}} -compMsg use_object mod location = - mod_str ++ replicate (max 0 (16 - length mod_str)) ' ' - ++" ( " ++ unJust "hscRecomp" (ml_hs_file location) ++ ", " - ++ (if use_object - then unJust "hscRecomp" (ml_obj_file location) - else "interpreted") - ++ " )" - where mod_str = moduleUserString mod - - hscRecomp ghci_mode dflags have_object mod location maybe_checked_iface hst hit pcs_ch = do { -- what target are we shooting for? - ; let toInterp = dopt_HscLang dflags == HscInterpreted + ; let toInterp = dopt_HscLang dflags == HscInterpreted ; let toNothing = dopt_HscLang dflags == HscNothing + ; let toCore = isJust (ml_hs_file location) && + isExtCore_file (fromJust (ml_hs_file location)) ; when (ghci_mode /= OneShot && verbosity dflags >= 1) $ hPutStrLn stderr ("Compiling " ++ - compMsg (not toInterp) mod location); - - ------------------- - -- PARSE - ------------------- - ; maybe_parsed <- myParseModule dflags - (unJust "hscRecomp:hspp" (ml_hspp_file location)) - ; case maybe_parsed of { - Nothing -> return (HscFail pcs_ch); - Just rdr_module -> do { - ; let this_mod = mkHomeModule (hsModuleName rdr_module) - - ------------------- - -- RENAME - ------------------- - ; (pcs_rn, print_unqualified, maybe_rn_result) - <- _scc_ "Rename" - renameModule dflags hit hst pcs_ch this_mod rdr_module - ; case maybe_rn_result of { - Nothing -> return (HscFail pcs_ch{-was: pcs_rn-}); - Just (is_exported, new_iface, rn_hs_decls) -> do { - - -- In interactive mode, we don't want to discard any top-level entities at - -- all (eg. do not inline them away during simplification), and retain them - -- all in the TypeEnv so they are available from the command line. - -- - -- isGlobalName separates the user-defined top-level names from those - -- introduced by the type checker. - ; let dont_discard | ghci_mode == Interactive = isGlobalName - | otherwise = is_exported + showModMsg (not toInterp) mod location); + + ; front_res <- + (if toCore then hscCoreFrontEnd else hscFrontEnd) + ghci_mode dflags location hst hit pcs_ch + ; case front_res of + Left flure -> return flure; + Right (this_mod, rdr_module, + dont_discard, new_iface, + pcs_tc, ds_details, foreign_stuff) -> do { + + let { + imported_module_names = + filter (/= gHC_PRIM_Name) $ + map ideclName (hsModuleImports rdr_module); + + imported_modules = + map (moduleNameToModule hit (pcs_PIT pcs_tc)) + imported_module_names; + } + + -- force this out now, so we don't keep a hold of rdr_module or pcs_tc + ; seqList imported_modules (return ()) ------------------- - -- TYPECHECK + -- FLATTENING ------------------- - ; maybe_tc_result - <- _scc_ "TypeCheck" typecheckModule dflags pcs_rn hst new_iface - print_unqualified rn_hs_decls - ; case maybe_tc_result of { - Nothing -> return (HscFail pcs_ch{-was: pcs_rn-}); - Just (pcs_tc, tc_result) -> do { - - ------------------- - -- DESUGAR - ------------------- - ; (ds_details, foreign_stuff) - <- _scc_ "DeSugar" - deSugar dflags pcs_tc hst this_mod print_unqualified tc_result + ; flat_details + <- _scc_ "Flattening" + flatten dflags pcs_tc hst ds_details ; pcs_middle - <- if ghci_mode == OneShot + <- _scc_ "pcs_middle" + if ghci_mode == OneShot then do init_pcs <- initPersistentCompilerState init_prs <- initPersistentRenamerState let @@ -271,12 +261,27 @@ hscRecomp ghci_mode dflags have_object pcs_rules = rules } else return pcs_tc +-- Should we remove bits of flat_details at this point? +-- ; flat_details <- case flat_details of +-- ModDetails { md_binds = binds } -> +-- return ModDetails { md_binds = binds, +-- md_rules = [], +-- md_types = emptyTypeEnv, +-- md_insts = [] } + + -- alive at this point: + -- pcs_middle + -- foreign_stuff + -- flat_details + -- imported_modules (seq'd) + -- new_iface + ------------------- -- SIMPLIFY ------------------- ; simpl_details <- _scc_ "Core2Core" - core2core dflags pcs_middle hst dont_discard ds_details + core2core dflags pcs_middle hst dont_discard flat_details ------------------- -- TIDY @@ -304,11 +309,16 @@ hscRecomp ghci_mode dflags have_object -- new_iface ; emitExternalCore dflags new_iface tidy_details + + ; let final_details = tidy_details {md_binds = []} + ; final_details `seq` return () + ------------------- -- PREPARE FOR CODE GENERATION ------------------- -- Do saturation and convert to A-normal form - ; prepd_details <- _scc_ "CorePrep" corePrepPgm dflags tidy_details + ; prepd_details <- _scc_ "CorePrep" + corePrepPgm dflags tidy_details ------------------- -- CONVERT TO STG and COMPLETE CODE GENERATION @@ -319,14 +329,23 @@ hscRecomp ghci_mode dflags have_object local_tycons = typeEnvTyCons env_tc local_classes = typeEnvClasses env_tc - imported_module_names = map ideclName (hsModuleImports rdr_module) - - mod_name_to_Module nm - = do m <- findModule nm ; return (fst (fromJust m)) + (h_code, c_code, headers, fe_binders) = foreign_stuff - (h_code,c_code,fe_binders) = foreign_stuff - - ; imported_modules <- mapM mod_name_to_Module imported_module_names + -- turn the list of headers requested in foreign import + -- declarations into a string suitable for emission into generated + -- C code... + -- + foreign_headers = + unlines + . map (\fname -> "#include \"" ++ unpackFS fname ++ "\"") + . reverse + $ headers + + -- ...and add the string to the headers requested via command line + -- options + -- + ; fhdrs <- readIORef v_HCHeader + ; writeIORef v_HCHeader (fhdrs ++ foreign_headers) ; (stub_h_exists, stub_c_exists, maybe_bcos, final_iface ) <- if toInterp @@ -344,7 +363,12 @@ hscRecomp ghci_mode dflags have_object mkFinalIface ghci_mode dflags location maybe_checked_iface new_iface tidy_details - return ( False, False, Just (bcos,itbl_env), final_iface ) + ------------------ Create f-x-dynamic C-side stuff --- + (istub_h_exists, istub_c_exists) + <- outputForeignStubs dflags c_code h_code + + return ( istub_h_exists, istub_c_exists, + Just (bcos,itbl_env), final_iface ) #else then error "GHC not compiled with interpreter" #endif @@ -353,7 +377,7 @@ hscRecomp ghci_mode dflags have_object ----------------- Convert to STG ------------------ (stg_binds, cost_centre_info, stg_back_end_info) <- _scc_ "CoreToStg" - myCoreToStg dflags this_mod binds + myCoreToStg dflags this_mod binds -- Fill in the code-gen info for the earlier tidyCorePgm writeIORef cg_info_ref (Just stg_back_end_info) @@ -362,49 +386,125 @@ hscRecomp ghci_mode dflags have_object final_iface <- _scc_ "MkFinalIface" mkFinalIface ghci_mode dflags location maybe_checked_iface new_iface tidy_details - if toNothing then do return (False, False, Nothing, final_iface) else do ------------------ Code generation ------------------ abstractC <- _scc_ "CodeGen" - codeGen dflags this_mod imported_modules + codeGen dflags this_mod imported_modules cost_centre_info fe_binders local_tycons stg_binds ------------------ Code output ----------------------- (stub_h_exists, stub_c_exists) - <- codeOutput dflags this_mod local_tycons + <- codeOutput dflags this_mod [] --local_tycons binds stg_binds c_code h_code abstractC return (stub_h_exists, stub_c_exists, Nothing, final_iface) - ; let final_details = tidy_details {md_binds = []} - - -- and the answer is ... ; return (HscRecomp pcs_final final_details final_iface stub_h_exists stub_c_exists maybe_bcos) - }}}}}}} + }} + +hscCoreFrontEnd ghci_mode dflags location hst hit pcs_ch = do { + ------------------- + -- PARSE + ------------------- + ; inp <- readFile (expectJust "hscCoreFrontEnd:hspp" (ml_hspp_file location)) + ; case parseCore inp 1 of + FailP s -> hPutStrLn stderr s >> return (Left (HscFail pcs_ch)); + OkP rdr_module -> do { + ; let this_mod = mkHomeModule (hsModuleName rdr_module) + + ------------------- + -- RENAME + ------------------- + ; (pcs_rn, print_unqual, maybe_rn_result) + <- renameExtCore dflags hit hst pcs_ch this_mod rdr_module + ; case maybe_rn_result of { + Nothing -> return (Left (HscFail pcs_ch)); + Just (dont_discard, new_iface, rn_decls) -> do { + + ------------------- + -- TYPECHECK + ------------------- + ; maybe_tc_result + <- _scc_ "TypeCheck" + typecheckCoreModule dflags pcs_rn hst new_iface rn_decls + ; case maybe_tc_result of { + Nothing -> return (Left (HscFail pcs_ch)); + Just (pcs_tc, tc_result) -> do { + + ------------------- + -- DESUGAR + ------------------- + ; (ds_details, foreign_stuff) <- deSugarCore tc_result + ; return (Right (this_mod, rdr_module, dont_discard, new_iface, + pcs_tc, ds_details, foreign_stuff)) + }}}}}} + + +hscFrontEnd ghci_mode dflags location hst hit pcs_ch = do { + ------------------- + -- PARSE + ------------------- + ; maybe_parsed <- myParseModule dflags + (expectJust "hscRecomp:hspp" (ml_hspp_file location)) + ; case maybe_parsed of { + Nothing -> return (Left (HscFail pcs_ch)); + Just rdr_module -> do { + ; let this_mod = mkHomeModule (hsModuleName rdr_module) + + ------------------- + -- RENAME + ------------------- + ; (pcs_rn, print_unqual, maybe_rn_result) + <- _scc_ "Rename" + renameModule dflags ghci_mode hit hst pcs_ch this_mod rdr_module + ; case maybe_rn_result of { + Nothing -> return (Left (HscFail pcs_ch)); + Just (dont_discard, new_iface, rn_result) -> do { + + ------------------- + -- TYPECHECK + ------------------- + ; maybe_tc_result + <- _scc_ "TypeCheck" + typecheckModule dflags pcs_rn hst print_unqual rn_result + ; case maybe_tc_result of { + Nothing -> return (Left (HscFail pcs_ch)); + Just (pcs_tc, tc_result) -> do { + + ------------------- + -- DESUGAR + ------------------- + ; (ds_details, foreign_stuff) + <- _scc_ "DeSugar" + deSugar dflags pcs_tc hst this_mod print_unqual tc_result + ; return (Right (this_mod, rdr_module, dont_discard, new_iface, + pcs_tc, ds_details, foreign_stuff)) + }}}}}}} + myParseModule dflags src_filename = do -------------------------- Parser ---------------- showPass dflags "Parser" _scc_ "Parser" do + buf <- hGetStringBuffer src_filename - buf <- hGetStringBuffer True{-expand tabs-} src_filename + let exts = ExtFlags {glasgowExtsEF = dopt Opt_GlasgowExts dflags, + ffiEF = dopt Opt_FFI dflags, + withEF = dopt Opt_With dflags, + parrEF = dopt Opt_PArr dflags} + loc = mkSrcLoc (mkFastString src_filename) 1 - let glaexts | dopt Opt_GlasgowExts dflags = 1# - | otherwise = 0# - - case parseModule buf PState{ bol = 0#, atbol = 1#, - context = [], glasgow_exts = glaexts, - loc = mkSrcLoc (_PK_ src_filename) 1 } of { + case parseModule buf (mkPState loc exts) of { PFailed err -> do { hPutStrLn stderr (showSDoc err); freeStringBuffer buf; @@ -427,15 +527,18 @@ myCoreToStg dflags this_mod tidy_binds () <- coreBindsSize tidy_binds `seq` return () -- TEMP: the above call zaps some space usage allocated by the -- simplifier, which for reasons I don't understand, persists - -- thoroughout code generation + -- thoroughout code generation -- JRS + -- + -- This is still necessary. -- SDM (10 Dec 2001) - stg_binds <- _scc_ "Core2Stg" coreToStg dflags tidy_binds + stg_binds <- _scc_ "Core2Stg" + coreToStg dflags tidy_binds - (stg_binds2, cost_centre_info) - <- _scc_ "Core2Stg" stg2stg dflags this_mod stg_binds + (stg_binds2, cost_centre_info) <- _scc_ "Core2Stg" + stg2stg dflags this_mod stg_binds let env_rhs :: CgInfoEnv - env_rhs = mkNameEnv [ (idName bndr, CgInfo caf_info) + env_rhs = mkNameEnv [ caf_info `seq` (idName bndr, CgInfo caf_info) | (bind,_) <- stg_binds2, let caf_info | stgBindHasCafRefs bind = MayHaveCafRefs @@ -512,8 +615,7 @@ hscStmt dflags hst hit pcs0 icontext stmt just_expr -- Rename it (pcs1, print_unqual, maybe_renamed_stmt) - <- renameStmt dflags hit hst pcs0 - iNTERACTIVE icontext parsed_stmt + <- renameStmt dflags hit hst pcs0 icontext parsed_stmt ; case maybe_renamed_stmt of Nothing -> return (pcs0, Nothing) @@ -535,8 +637,11 @@ hscStmt dflags hst hit pcs0 icontext stmt just_expr -- Desugar it ds_expr <- deSugarExpr dflags pcs2 hst iNTERACTIVE print_unqual tc_expr + -- Flatten it + ; flat_expr <- flattenExpr dflags pcs2 hst ds_expr + -- Simplify it - ; simpl_expr <- simplifyExpr dflags pcs2 hst ds_expr + ; simpl_expr <- simplifyExpr dflags pcs2 hst flat_expr -- Tidy it (temporary, until coreSat does cloning) ; tidy_expr <- tidyCoreExpr simpl_expr @@ -564,16 +669,17 @@ hscParseStmt :: DynFlags -> String -> IO (Maybe RdrNameStmt) hscParseStmt dflags str = do -------------------------- Parser ---------------- showPass dflags "Parser" - _scc_ "Parser" do + _scc_ "Parser" do buf <- stringToStringBuffer str - let glaexts | dopt Opt_GlasgowExts dflags = 1# - | otherwise = 0# + let exts = ExtFlags {glasgowExtsEF = dopt Opt_GlasgowExts dflags, + ffiEF = dopt Opt_FFI dflags, + withEF = dopt Opt_With dflags, + parrEF = dopt Opt_PArr dflags} + loc = mkSrcLoc FSLIT("") 1 - case parseStmt buf PState{ bol = 0#, atbol = 1#, - context = [], glasgow_exts = glaexts, - loc = mkSrcLoc SLIT("") 1 } of { + case parseStmt buf (mkPState loc exts) of { PFailed err -> do { hPutStrLn stderr (showSDoc err); -- Not yet implemented in <4.11 freeStringBuffer buf; @@ -611,7 +717,7 @@ hscThing -- like hscStmt, but deals with a single identifier -> IO ( PersistentCompilerState, [TyThing] ) -hscThing dflags hst hit pcs0 icontext str +hscThing dflags hst hit pcs0 ic str = do maybe_rdr_name <- myParseIdentifier dflags str case maybe_rdr_name of { Nothing -> return (pcs0, []); @@ -629,7 +735,7 @@ hscThing dflags hst hit pcs0 icontext str tccls_name = setRdrNameOcc rdr_name tccls_occ (pcs, unqual, maybe_rn_result) <- - renameRdrName dflags hit hst pcs0 iNTERACTIVE icontext rdr_names + renameRdrName dflags hit hst pcs0 ic rdr_names case maybe_rn_result of { Nothing -> return (pcs, []); @@ -641,7 +747,11 @@ hscThing dflags hst hit pcs0 icontext str case maybe_pcs of { Nothing -> return (pcs, []); Just pcs -> - let maybe_ty_things = map (lookupType hst (pcs_PTE pcs)) names + let do_lookup n + | isInternalName n = lookupNameEnv (ic_type_env ic) n + | otherwise = lookupType hst (pcs_PTE pcs) n + + maybe_ty_things = map do_lookup names in return (pcs, catMaybes maybe_ty_things) } }}} @@ -649,13 +759,13 @@ hscThing dflags hst hit pcs0 icontext str myParseIdentifier dflags str = do buf <- stringToStringBuffer str - let glaexts | dopt Opt_GlasgowExts dflags = 1# - | otherwise = 0# + let exts = ExtFlags {glasgowExtsEF = dopt Opt_GlasgowExts dflags, + ffiEF = dopt Opt_FFI dflags, + withEF = dopt Opt_With dflags, + parrEF = dopt Opt_PArr dflags} + loc = mkSrcLoc FSLIT("") 1 - case parseIdentifier buf - PState{ bol = 0#, atbol = 1#, - context = [], glasgow_exts = glaexts, - loc = mkSrcLoc SLIT("") 1 } of + case parseIdentifier buf (mkPState loc exts) of PFailed err -> do { hPutStrLn stderr (showSDoc err); freeStringBuffer buf; @@ -668,6 +778,62 @@ myParseIdentifier dflags str %************************************************************************ %* * +\subsection{Find all the things defined in a module} +%* * +%************************************************************************ + +\begin{code} +#ifdef GHCI +hscModuleContents + :: DynFlags + -> HomeSymbolTable + -> HomeIfaceTable + -> PersistentCompilerState -- IN: persistent compiler state + -> Module -- module to inspect + -> Bool -- grab just the exports, or the whole toplev + -> IO (PersistentCompilerState, Maybe [TyThing]) + +hscModuleContents dflags hst hit pcs0 mod exports_only = do { + + -- slurp the interface if necessary + (pcs1, print_unqual, maybe_rn_stuff) + <- slurpIface dflags hit hst pcs0 mod; + + case maybe_rn_stuff of { + Nothing -> return (pcs0, Nothing); + Just (names, rn_decls) -> do { + + -- Typecheck the declarations + maybe_pcs <- + typecheckExtraDecls dflags pcs1 hst print_unqual iNTERACTIVE rn_decls; + + case maybe_pcs of { + Nothing -> return (pcs1, Nothing); + Just pcs2 -> + + let { all_names + | exports_only = names + | otherwise = + let { iface = fromJust (lookupModuleEnv hit mod); + env = fromJust (mi_globals iface); + range = rdrEnvElts env; + } in + -- grab all the things from the global env that are locally def'd + nub [ n | elts <- range, GRE n LocalDef _ <- elts ]; + + pte = pcs_PTE pcs2; + + ty_things = map (fromJust . lookupType hst pte) all_names; + + } in + + return (pcs2, Just ty_things) + }}}} +#endif +\end{code} + +%************************************************************************ +%* * \subsection{Initial persistent state} %* * %************************************************************************